cxscrollbar.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,042 行 · 第 1/3 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressCommonLibrary                                         }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCOMMONLIBRARY AND ALL          }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxScrollBar;

{$I cxVer.inc}

interface

uses
  Windows, Messages, dxThemeManager,
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
{$IFNDEF DELPHI5}
  cxClasses,
{$ENDIF}
  SysUtils, Classes, Controls, StdCtrls,
  Graphics, cxGraphics, Forms, cxLookAndFeels, cxLookAndFeelPainters;

type
  TcxScrollBar = class;

  TcxScrollBarState = record
    PressedPart: TcxScrollBarPart;
    HotPart: TcxScrollBarPart;
  end;

  { TcxScrollBarViewInfo }

  TcxScrollBarViewInfo = class
  protected
    FBottomRightArrowRect: TRect;
    FPageDownRect: TRect;
    FPageUpRect: TRect;
    FScrollBar: TcxScrollBar;
    FThumbnailRect: TRect;
    FThumbnailSize: Integer;
    FTopLeftArrowRect: TRect;
    procedure CalculateRects; virtual;
    property ScrollBar: TcxScrollBar read FScrollBar;
  public
    constructor Create(AScrollBar: TcxScrollBar); virtual;
    procedure AdjustPageRects;
    procedure Calculate; virtual;
    procedure CalculateMinThumnailSize;
    procedure CalculateThumbnailRect;
    procedure SetThumbnailPos(APos: Integer);
    property BottomRightArrowRect: TRect read FBottomRightArrowRect;
    property PageDownRect: TRect read FPageDownRect;
    property PageUpRect: TRect read FPageUpRect;
    property ThumbnailRect: TRect read FThumbnailRect;
    property ThumbnailSize: Integer read FThumbnailSize;
    property TopLeftArrowRect: TRect read FTopLeftArrowRect;
  end;

  TcxScrollBarViewInfoClass = class of TcxScrollBarViewInfo;

  TcxScrollBar = class(TCustomControl, {$IFNDEF DELPHI6}IUnknown,{$ENDIF} IdxSkinSupport)
  private
    FBitmap: TBitmap;
    FCanvas: TcxCanvas;
    FDownMousePos: TPoint;
    FKind: TScrollBarKind;
    FLargeChange: TScrollBarInc;
    FLookAndFeel: TcxLookAndFeel;
    FMax: Integer;
    FMin: Integer;
    FPageSize: Integer;
    FPosition: Integer;
    FRealCtl3D: Boolean;
    FSavePosition: Integer;
    FSaveThumbnailPos: TPoint;
    FSmallChange: TScrollBarInc;
    FThemeChangedNotificator: TdxThemeChangedNotificator;
    FTimer: TComponent;
    FUnlimitedTracking: Boolean;
    FOnChange: TNotifyEvent;
    FOnScroll: TScrollEvent;
    procedure CancelScroll;
    procedure DoScroll(APart: TcxScrollBarPart);
    function GetCtr3D: Boolean;
    function GetInternalCtl3D: Boolean;
    function GetPositionFromThumbnail: Integer;
    function GetScrollBarPart(P: TPoint): TcxScrollBarPart;
    procedure InternalScroll(AScrollCode: TScrollCode);
    function IsCtl3DStored: Boolean;
    procedure OnTimer(Sender: TObject);
    procedure SetCtl3D(Value: Boolean);
    procedure SetInternalCtl3D(Value: Boolean);
    procedure SetKind(Value: TScrollBarKind);
    procedure SetLookAndFeel(Value: TcxLookAndFeel);
    procedure SetMax(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetPageSize(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure ThemeChanged;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
    procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
    procedure CNCtlColorScrollBar(var Message: TMessage); message CN_CTLCOLORSCROLLBAR;
    procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    FState: TcxScrollBarState;
    FViewInfo: TcxScrollBarViewInfo;
    procedure Change; virtual;
    function GetPainter: TcxCustomLookAndFeelPainterClass;
    function GetViewInfoClass: TcxScrollBarViewInfoClass; virtual;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(AControl: TControl); dynamic;
    procedure MouseLeave(AControl: TControl); dynamic;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;

    procedure DoPaint(ACanvas: TcxCanvas); virtual;
    procedure DrawScrollBarPart(ACanvas: TcxCanvas; const R: TRect;
      APart: TcxScrollBarPart; AState: TcxButtonState); virtual;
    function IsButtonHotTrack: Boolean; virtual;
    procedure Paint; override;
    procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); virtual;
    function ScrollBarMinimalThumbSize: Integer; virtual;

    property InternalCtl3D: Boolean read GetInternalCtl3D write SetInternalCtl3D;
    property Painter: TcxCustomLookAndFeelPainterClass read GetPainter;
    property ViewInfo: TcxScrollBarViewInfo read FViewInfo;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure SetScrollParams(AMin, AMax, APosition, APageSize: Integer; ARedraw: Boolean = True);
    procedure SetParams(APosition, AMin, AMax: Integer);
  published
    property Align;
    property Anchors;
    property Constraints;
    property Ctl3D read GetCtr3D write SetCtl3D stored IsCtl3DStored;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
    property LargeChange: TScrollBarInc
      read FLargeChange write FLargeChange
      default 1;
    property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property PageSize: Integer read FPageSize write SetPageSize;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property Position: Integer
      read FPosition write SetPosition
      default 0;
    property ShowHint;
    property SmallChange: TScrollBarInc
      read FSmallChange write FSmallChange
      default 1;
    property UnlimitedTracking: Boolean read FUnlimitedTracking write FUnlimitedTracking default False;
    property Visible;
  {$IFDEF DELPHI5}
    property OnContextPopup;
  {$ENDIF}
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
    property OnStartDock;
    property OnStartDrag;
  end;
  TcxScrollBarClass = class of TcxScrollBar;

function GetScrollBarSize: TSize;      

implementation

uses
  dxuxTheme,
  dxThemeConsts,
  Consts, cxControls;

const
  EmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
  cxScrollInitialInterval = 400;
  cxScrollInterval = 60;
  cxScrollMinDistance: Integer = 34;
  cxScrollMaxDistance: Integer = 136;
  cxMinStdThumbnailSize = 8;
  cxTimerParts = [sbpLineUp, sbpLineDown, sbpPageUp, sbpPageDown];

function GetScrollBarSize: TSize;
begin
  Result.cx := GetSystemMetrics(SM_CXVSCROLL);
  Result.cy := GetSystemMetrics(SM_CYHSCROLL);
end;

function MaxInt(A, B: Integer): Integer;
begin
  if A > B then Result := A else Result := B;
end;

function MinInt(A, B: Integer): Integer;
begin
  if A < B then Result := A else Result := B;
end;

{$IFNDEF DELPHI6}

function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
begin
  with Result do
  begin
    Left := ALeft;
    Top := ATop;
    Right := ALeft + AWidth;
    Bottom :=  ATop + AHeight;
  end;
end;

{$ENDIF}

{ TcxScrollBarViewInfo }

constructor TcxScrollBarViewInfo.Create(AScrollBar: TcxScrollBar);
begin
  inherited Create;
  FScrollBar := AScrollBar;
end;

procedure TcxScrollBarViewInfo.AdjustPageRects;
begin
  if not IsRectEmpty(FThumbnailRect) then
  begin
    if ScrollBar.Kind = sbHorizontal then
    begin
      FPageUpRect := Rect(FTopLeftArrowRect.Right, 0, FThumbnailRect.Left, ScrollBar.Height);
      FPageDownRect := Rect(FThumbnailRect.Right, 0, FBottomRightArrowRect.Left, ScrollBar.Height);
    end
    else
    begin
      FPageUpRect := Rect(0, FTopLeftArrowRect.Bottom, ScrollBar.Width, FThumbnailRect.Top);
      FPageDownRect := Rect(0, FThumbnailRect.Bottom, ScrollBar.Width, FBottomRightArrowRect.Top);
    end
  end
  else
  begin
    FPageUpRect := EmptyRect;
    FPageDownRect := EmptyRect;
  end;
end;

procedure TcxScrollBarViewInfo.Calculate;
begin
  CalculateRects;
end;

procedure TcxScrollBarViewInfo.CalculateMinThumnailSize;
begin
  FThumbnailSize := ScrollBar.ScrollBarMinimalThumbSize;
end;

procedure TcxScrollBarViewInfo.CalculateThumbnailRect;
var
  ADelta, ASize: Integer;
begin
  FThumbnailRect := EmptyRect;
  AdjustPageRects;
  if not ScrollBar.Enabled then
    Exit;
  if ScrollBar.Kind = sbHorizontal then
  begin
    ADelta := FBottomRightArrowRect.Left - FTopLeftArrowRect.Right;
    if ScrollBar.PageSize = 0 then
    begin
      ASize := GetSystemMetrics(SM_CXHTHUMB);
      if ASize > ADelta then
        Exit;
      Dec(ADelta, ASize);
      if (ADelta <= 0) or (ScrollBar.Max = ScrollBar.Min) then
        FThumbnailRect := Bounds(FTopLeftArrowRect.Right, 0, ASize, ScrollBar.Height)
      else
        FThumbnailRect := Bounds(FTopLeftArrowRect.Right +
          MulDiv(ADelta, ScrollBar.Position - ScrollBar.Min, ScrollBar.Max - ScrollBar.Min), 0, ASize, ScrollBar.Height);
    end
    else
    begin
      ASize := MinInt(ADelta, MulDiv(ScrollBar.PageSize, ADelta, ScrollBar.Max - ScrollBar.Min + 1));
      if (ADelta < FThumbnailSize) or (ScrollBar.Max = ScrollBar.Min) then
        Exit;
      if ASize < FThumbnailSize then
        ASize := FThumbnailSize;
      Dec(ADelta, ASize);
      FThumbnailRect := Bounds(FTopLeftArrowRect.Right, 0, ASize, ScrollBar.Height);
      ASize := (ScrollBar.Max - ScrollBar.Min) - (ScrollBar.PageSize - 1);
      OffsetRect(FThumbnailRect, MulDiv(ADelta, MinInt(ScrollBar.Position - ScrollBar.Min, ASize), ASize), 0);
    end;
  end
  else
  begin