dfssplitter.pas

动态提示控件

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

{------------------------------------------------------------------------------}
{ TdfsSplitter v2.03                                                           }
{------------------------------------------------------------------------------}
{ A descendant of the TSplitter component (D3, C3, & D4) that adds a           }
{ "maximize - restore" button.  This mimics the behavior of the splitter in    }
{ Netscape Communicator v4.5.  Clicking the button moves the splitter to its   }
{ farthest extreme.  Clicking again returns it to the last position.           }
{                                                                              }
{ 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 DFSSplitter.txt for notes, known issues, and revision history.           }
{------------------------------------------------------------------------------}
{ Date last modified:  June 27, 2001                                           }
{------------------------------------------------------------------------------}

unit dfsSplitter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

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 = 'TdfsSplitter v2.03';
  MOVEMENT_TOLERANCE = 5; // See WMLButtonUp message handler.
  DEF_BUTTON_HIGHLIGHT_COLOR = $00FFCFCF; // RGB(207,207,255)

type
  TdfsButtonWidthType = (btwPixels, btwPercentage);
  TdfsButtonStyle = (bsNetscape, bsWindows);
  TdfsWindowsButton = (wbMin, wbMax, wbClose);
  TdfsWindowsButtons = set of TdfsWindowsButton;

  TdfsSplitter = class(TSplitter)
  private
    FShowButton: boolean;
    FButtonWidthType: TdfsButtonWidthType;
    FButtonWidth: integer;
    FOnMaximize: TNotifyEvent;
    FOnMinimize: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FMaximized: boolean;
    FMinimized: boolean;
    // Internal use for "restoring" from "maximized" state
    FRestorePos: integer;
    // For internal use to avoid calling GetButtonRect when not necessary
    FLastKnownButtonRect: TRect;
    // Internal use to avoid unecessary painting
    FIsHighlighted: boolean;
    // Internal for detecting real clicks
    FGotMouseDown: boolean;
    FButtonColor: TColor;
    FButtonHighlightColor: TColor;
    FArrowColor: TColor;
    FTextureColor1: TColor;
    FTextureColor2: TColor;
    FAutoHighlightColor : boolean;
    FAllowDrag: boolean;
    FButtonStyle: TdfsButtonStyle;
    FWindowsButtons: TdfsWindowsButtons;
    FOnClose: TNotifyEvent;
    FButtonCursor: TCursor;
    procedure SetShowButton(const Value: boolean);
    procedure SetButtonWidthType(const Value: TdfsButtonWidthType);
    procedure SetButtonWidth(const Value: integer);
    function GetButtonRect: TRect;
    procedure SetMaximized(const Value: boolean);
    procedure SetMinimized(const Value: boolean);
    function GetAlign: TAlign;
    procedure SetAlign(Value: TAlign);
    procedure SetArrowColor(const Value: TColor);
    procedure SetButtonColor(const Value: TColor);
    procedure SetButtonHighlightColor(const Value: TColor);
    procedure SetButtonStyle(const Value: TdfsButtonStyle);
    procedure SetTextureColor1(const Value: TColor);
    procedure SetTextureColor2(const Value: TColor);
    procedure SetAutoHighLightColor(const Value: boolean);
    procedure SetAllowDrag(const Value: boolean);
    procedure SetWindowsButtons(const Value: TdfsWindowsButtons);
    procedure SetButtonCursor(const Value: TCursor);
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
  protected
    // Internal use for moving splitter position with FindControl and
    // UpdateControlSize
    FControl: TControl;
    FDownPos: TPoint;

    procedure LoadOtherProperties(Reader: TReader); dynamic;
    procedure StoreOtherProperties(Writer: TWriter); dynamic;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Paint; override;
    {$IFDEF DFS_COMPILER_4_UP}
    function DoCanResize(var NewSize: integer): boolean; override;
    {$ENDIF}
    procedure Loaded; override;
    procedure PaintButton(Highlight: boolean); dynamic;
    function DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer;
       ArrowSize: integer; Color: TColor): integer; dynamic;
    function WindowButtonHitTest(X, Y: integer): TdfsWindowsButton; dynamic;
    function ButtonHitTest(X, Y: integer): boolean; dynamic;
    procedure DoMaximize; dynamic;
    procedure DoMinimize; dynamic;
    procedure DoRestore; dynamic;
    procedure DoClose; dynamic;
    procedure FindControl; dynamic;
    procedure UpdateControlSize(NewSize: integer); dynamic;
    function GrabBarColor: TColor;
    function VisibleWinButtons: integer;
  public
    constructor Create(AOwner: TComponent); override;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    property ButtonRect: TRect
       read GetButtonRect;
    property RestorePos: integer
       read FRestorePos
       write FRestorePos;
  published
    property Maximized: boolean
       read FMaximized
       write SetMaximized;
    property Minimized: boolean
       read FMinimized
       write SetMinimized;


    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property AllowDrag: boolean
       read FAllowDrag
       write SetAllowDrag
       default TRUE;
    property ButtonCursor: TCursor
       read FButtonCursor
       write SetButtonCursor;
    property ButtonStyle: TdfsButtonStyle
       read FButtonStyle
       write SetButtonStyle
       default bsNetscape;
    property WindowsButtons: TdfsWindowsButtons
       read FWindowsButtons
       write SetWindowsButtons
       default [wbMin, wbMax, wbClose];
    property ButtonWidthType: TdfsButtonWidthType
       read FButtonWidthType
       write SetButtonWidthType
       default btwPixels;
    property ButtonWidth: integer
       read FButtonWidth
       write SetButtonWidth
       default 100;
    property ShowButton: boolean
       read FShowButton
       write SetShowButton
       default TRUE;
    property ButtonColor: TColor
       read FButtonColor
       write SetButtonColor
       default clBtnFace;
    property ArrowColor: TColor
       read FArrowColor
       write SetArrowColor
       default clNavy;
    property ButtonHighlightColor: TColor
       read FButtonHighlightColor
       write SetButtonHighlightColor
       default DEF_BUTTON_HIGHLIGHT_COLOR;
    property AutoHighlightColor: Boolean
       read FAutoHighlightColor
       write SetAutoHighlightColor
       default FALSE;
    property TextureColor1: TColor
       read FTextureColor1
       write SetTextureColor1
       default clWhite;
    property TextureColor2: TColor
       read FTextureColor2
       write SetTextureColor2
       default clNavy;
    property Align: TAlign // Need to know when it changes to redraw arrows
       read GetAlign
       write SetAlign;
    property Width
       default 10;  // it looks best with 10
    property Beveled
       default FALSE; // it looks best without the bevel
    property Enabled;

    property OnClose: TNotifyEvent
       read FOnClose
       write FOnClose;
    property OnMaximize: TNotifyEvent
       read FOnMaximize
       write FOnMaximize;
    property OnMinimize: TNotifyEvent
       read FOnMinimize
       write FOnMinimize;
    property OnRestore: TNotifyEvent
       read FOnRestore
       write FOnRestore;
  end;

implementation

{ TdfsSplitter }

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

  Beveled := FALSE;
  FAllowDrag := TRUE;
  FButtonStyle := bsNetscape;
  FWindowsButtons := [wbMin, wbMax, wbClose];
  FButtonWidthType := btwPixels;
  FButtonWidth := 100;
  FShowButton := TRUE;
  SetRectEmpty(FLastKnownButtonRect);
  FIsHighlighted := FALSE;
  FGotMouseDown := FALSE;
  FControl := NIL;
  FDownPos := Point(0,0);
  FMaximized := FALSE;
  FMinimized := FALSE;
  FRestorePos := -1;
  Width := 10;
  FButtonColor := clBtnFace;
  FArrowColor := clNavy;
  FButtonHighlightColor := DEF_BUTTON_HIGHLIGHT_COLOR;
  FAutoHighLightColor := FALSE;
  FTextureColor1 := clWhite;
  FTextureColor2 := clNavy;
end;

function TdfsSplitter.GrabBarColor: TColor;
var
  BeginRGB: array[0..2] of Byte;
  RGBDifference: array[0..2] of integer;
  R,G,B: Byte;
  BeginColor,
  EndColor: TColor;
  NumberOfColors: integer;

begin
  //Need to figure out how many colors available at runtime
  NumberOfColors := 256;

  BeginColor := clActiveCaption;
  EndColor := clBtnFace;

  BeginRGB[0] := GetRValue(ColorToRGB(BeginColor));
  BeginRGB[1] := GetGValue(ColorToRGB(BeginColor));
  BeginRGB[2] := GetBValue(ColorToRGB(BeginColor));

  RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGB[0];
  RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGB[1];
  RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGB[2];

  R := BeginRGB[0] + MulDiv (180, RGBDifference[0], NumberOfColors - 1);
  G := BeginRGB[1] + MulDiv (180, RGBDifference[1], NumberOfColors - 1);
  B := BeginRGB[2] + MulDiv (180, RGBDifference[2], NumberOfColors - 1);

  Result := RGB (R, G, B);
end;

function TdfsSplitter.DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer;
   ArrowSize: integer; Color: TColor): integer;
var
  x, y, q, i, j: integer;
  ArrowAlign: TAlign;
begin
  // STB Nitro drivers have a LineTo bug, so I've opted to use the slower
  // SetPixel method to draw the arrows.

  if not Odd(ArrowSize) then
    Dec(ArrowSize);
  if ArrowSize < 1 then
    ArrowSize := 1;

  if FMaximized then
  begin
    case Align of
      alLeft:   ArrowAlign := alRight;
      alRight:  ArrowAlign := alLeft;
      alTop:    ArrowAlign := alBottom;
    else //alBottom
      ArrowAlign := alTop;
    end;
  end else
    ArrowAlign := Align;
  q := ArrowSize * 2 - 1 ;
  Result := q;
  ACanvas.Pen.Color := Color;
  with AvailableRect do
  begin
    case ArrowAlign of
      alLeft:
        begin
          x := Left + ((Right - Left - ArrowSize) div 2) + 1;
          if Offset < 0 then
            y := Bottom + Offset - q
          else
            y := Top + Offset;
          for j := x + ArrowSize - 1 downto x do
          begin
            for i := y to y + q - 1 do
              ACanvas.Pixels[j, i] := Color;
            inc(y);
            dec(q,2);
          end;
        end;
      alRight:
        begin
          x := Left + ((Right - Left - ArrowSize) div 2) + 1;
          if Offset < 0 then
            y := Bottom + Offset - q
          else
            y := Top + Offset;
          for j := x to x + ArrowSize - 1 do
          begin
            for i := y to y + q - 1 do
              ACanvas.Pixels[j, i] := Color;
            inc(y);
            dec(q,2);
          end;
        end;
      alTop:
        begin
          if Offset < 0 then
            x := Right + Offset - q
          else
            x := Left + Offset;
          y := Top + ((Bottom - Top - ArrowSize) div 2) + 1;
          for i := y + ArrowSize - 1 downto y do
          begin
            for j := x to x + q - 1 do
              ACanvas.Pixels[j, i] := Color;
            inc(x);
            dec(q,2);
          end;
        end;
    else // alBottom
      if Offset < 0 then
        x := Right + Offset - q
      else
        x := Left + Offset;
      y := Top + ((Bottom - Top - ArrowSize) div 2) + 1;
      for i := y to y + ArrowSize - 1 do
      begin
        for j := x to x + q - 1 do
          ACanvas.Pixels[j, i] := Color;
        inc(x);
        dec(q,2);
      end;
    end;
  end;
end;

function TdfsSplitter.GetButtonRect: TRect;
var
  BW: integer;
begin
  if ButtonStyle = bsWindows then
  begin
    if Align in [alLeft, alRight] then
      BW := (ClientRect.Right - ClientRect.Left) * VisibleWinButtons
    else
      BW := (ClientRect.Bottom - ClientRect.Top) * VisibleWinButtons;
    if BW < 1 then
      SetRectEmpty(Result)
    else
    begin
      if Align in [alLeft, alRight] then
        Result := Rect(0, 0, ClientRect.Right - ClientRect.Left, BW -
          VisibleWinButtons)
      else
        Result := Rect(ClientRect.Right - BW + VisibleWinButtons, 0,
          ClientRect.Right, ClientRect.Bottom - ClientRect.Top);
      InflateRect(Result, -1, -1);
    end;
  end
  else
  begin
    // Calc the rectangle the button goes in
    if ButtonWidthType = btwPercentage then
    begin
      if Align in [alLeft, alRight] then
        BW := ClientRect.Bottom - ClientRect.Top
      else
        BW := ClientRect.Right - ClientRect.Left;
      BW := MulDiv(BW, FButtonWidth, 100);
    end
    else
      BW := FButtonWidth;
    if BW < 1 then
      SetRectEmpty(Result)
    else