strackbar.pas

AlphaControls是一个Delphi标准控件的集合

unit sTrackBar;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls,
  commctrl, consts, sConst, sStyleUtil, sUtils, sGraphUtils, ExtCtrls, sDefaults;

type
  TAPoint = array of TPoint;

  TsTrackBar = class;

  TFadeTimer = class(TTimer)
  private
    FOwner: TsTrackBar;
    procedure SetDirection(const Value: TFadeDirection);
  public
    FDirection : TFadeDirection;
    constructor Create(AOwner: TComponent); override;
    procedure FadeUp;
    procedure FadeDown;
    procedure Timer; override;
    procedure TimerAction(Sender : TObject);
    procedure ToEnd;
    property Direction : TFadeDirection read FDirection write SetDirection;
  end;

  TsTrackBar = class(TCustomControl)
  private
    FOrientation: TTrackBarOrientation;
    FTickMarks: TTickMark;
    FTickStyle: TTickStyle;
    FLineSize: Integer;
    FPageSize: Integer;
    FThumbLength: Integer;
    FSliderVisible: Boolean;
    FsStyle : TsActiveBGStyle;
    FMin: Integer;
    FMax: Integer;
    FFrequency: Integer;
    FSelStart: Integer;
    FSelEnd: Integer;
    FOnChange: TNotifyEvent;
    FDisabledKind: TsDisabledKind;
    function CreateTempBmp : TBitmap;
    function GetThumbLength: Integer;
    procedure SetOrientation(Value: TTrackBarOrientation);
    procedure SetParams(APosition, AMin, AMax: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetFrequency(Value: Integer);
    procedure SetTickStyle(Value: TTickStyle);
    procedure SetTickMarks(Value: TTickMark);
    procedure SetLineSize(Value: Integer);
    procedure SetPageSize(Value: Integer);
    procedure SetThumbLength(Value: Integer);
    procedure SetSliderVisible(Value: Boolean);
    procedure SetSelStart(Value: Integer);
    procedure SetSelEnd(Value: Integer);
    procedure UpdateSelection;
    procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
    procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
//    FBackBmp : TBitmap;
    FFullRepaint : boolean;
    procedure SetParamsMsg;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure WndProc (var Message: TMessage); override;
    procedure Changed; dynamic;
    procedure WMEraseBkGND (var Message: TWMPaint); message WM_ERASEBKGND;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    FPosition: Integer;
    TickHeight : integer;
    tCount: integer;
    iStep : real;
    Thumb : TBitmap;

    OldBmp : TBitmap;
    FadeLevel : integer;
    Direction : boolean;
    FadeTimer : TFadeTimer;
    procedure PaintNewBmp;

    procedure StartFadeIn;
    procedure StartFadeOut;
    procedure StopFading;

    procedure PaintBody(aRect: TRect);
    procedure PaintBar;
    procedure PaintTicksHor;
    procedure PaintTicksVer;
//    function GetMaskIndex(mask : string) : integer;

    procedure PaintThumb(i: integer); overload;
    procedure PaintThumb(Bmp : TBitmap; i: integer); overload;
    procedure PaintWnd(Canvas: TCanvas; aRect: TsRect; Text: string; Enabled: boolean; Flags: Longint);
    function ThumbRect: TRect;
    function ChannelRect: TRect;
    function TicPos(i: integer): TPoint;
    function TickCount : integer;
    function TicksArray : TAPoint;
    procedure PaintFromCache(aRect: TRect);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure Paint; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;

    procedure SetTick(Value: Integer);
    function Margin: integer;
    property LineSize: Integer read FLineSize write SetLineSize default 1;
  published
    property Align;
    property Anchors;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property Orientation: TTrackBarOrientation read FOrientation write SetOrientation;
    property ParentShowHint;
    property PageSize: Integer read FPageSize write SetPageSize default 1;
    property PopupMenu;
    property Frequency: Integer read FFrequency write SetFrequency default 5;
    property Position: Integer read FPosition write SetPosition;
    property SliderVisible: Boolean read FSliderVisible write SetSliderVisible default True;
    property SelEnd: Integer read FSelEnd write SetSelEnd;
    property SelStart: Integer read FSelStart write SetSelStart;
    property sStyle : TsActiveBGStyle read FsStyle write FsStyle;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property ThumbLength: Integer read GetThumbLength write SetThumbLength default 9;
    property TickMarks: TTickMark read FTickMarks write SetTickMarks;
    property TickStyle: TTickStyle read FTickStyle write SetTickStyle;
    property Visible;
    property OnContextPopup;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDock;
    property OnStartDrag;
  end;


implementation

uses sBorders, sStyleSimply, sMaskData, sSkinProps, sAlphaGraph;

{ TsTrackBar }

constructor TsTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle := TsActiveBGStyle.Create(Self);
  sStyle.COC := COC_TsTrackBar;

//  FBackBmp := CreateTempBmp;
  Thumb := TBitmap.Create;
  Thumb.PixelFormat := pf24Bit;

  ControlStyle := ControlStyle + [csOpaque] - [csDoubleClicks];
//  Parent := TWinControl(AOwner);

  Width := 150;
  Height := 22;
  TabStop := True;
  FMin := 0;
  FMax := 100;
  FLineSize := 1;
  FPageSize := 1;
  FFrequency := 5;
  FThumbLength := 9;
  FTickMarks := tmBottomRight;
  FTickStyle := tsAuto;
  FOrientation := trHorizontal;
  FSliderVisible := True;
  TickHeight := 5;
  FFullRepaint := True;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsTrackBar;
    sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsTrackBarHot;
  end;
  RecreateWnd;

  OldBmp := TBitmap.Create;
  OldBmp.PixelFormat := pf24Bit;

  FadeTimer := TFadeTimer.Create(Self);
  FadeTimer.Enabled := False;
  FDisabledKind := DefDisabledKind;
end;


procedure TsTrackBar.CreateParams(var Params: TCreateParams);
const
  OrientationStyle: array[TTrackbarOrientation] of DWORD = (TBS_HORZ, TBS_VERT);
  TickStyles: array[TTickStyle] of DWORD = (TBS_NOTICKS, TBS_AUTOTICKS, 0);
  ATickMarks: array[TTickMark] of DWORD = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
begin

  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, TRACKBAR_CLASS);
  with Params do begin
    Style := Style or OrientationStyle[FOrientation] or
      TickStyles[FTickStyle] or ATickMarks[FTickMarks] or TBS_FIXEDLENGTH or
      TBS_ENABLESELRANGE;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW) or CS_DBLCLKS;
    if not FSliderVisible then Style := Style or TBS_NOTHUMB;
  end;
end;

procedure TsTrackBar.CreateWnd;
begin
  inherited CreateWnd;
  SetParamsMsg;
end;

procedure TsTrackBar.DestroyWnd;
begin
  inherited DestroyWnd;
end;

procedure TsTrackBar.CNHScroll(var Message: TWMHScroll);
begin
  if not RestrictDrawing then sStyle.BGChanged := True;
  FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  Changed;
  Message.Result := 0;
end;

procedure TsTrackBar.CNVScroll(var Message: TWMVScroll);
begin
  if not RestrictDrawing then sStyle.BGChanged := True;
  FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  Changed;
  Message.Result := 0;
end;

function TsTrackBar.GetThumbLength: Integer;
begin
  if HandleAllocated then
    Result := SendMessage(Handle, TBM_GETTHUMBLENGTH, 0, 0)
  else
    Result := FThumbLength;
end;

procedure TsTrackBar.SetOrientation(Value: TTrackBarOrientation);
begin
  if Value <> FOrientation then begin
    FOrientation := Value;
    if ComponentState * [csLoading, csUpdating] = [] then
      SetBounds(Left, Top, Height, Width);
    RecreateWnd;
  end;
end;

procedure TsTrackBar.SetParams(APosition, AMin, AMax: Integer);
begin
  if AMax < AMin then raise EInvalidOperation.CreateFmt(SPropertyOutOfRange, [Self.Classname]);
  if APosition < AMin then APosition := AMin;
  if APosition > AMax then APosition := AMax;
  if (FMin <> AMin) then begin
    FMin := AMin;
    if HandleAllocated then SendMessage(Handle, TBM_SETRANGEMIN, 1, AMin);
  end;
  if (FMax <> AMax) then begin
    FMax := AMax;
    if HandleAllocated then SendMessage(Handle, TBM_SETRANGEMAX, 1, AMax);
  end;
  if FPosition <> APosition then begin

    FPosition := APosition;
    if HandleAllocated then SendMessage(Handle, TBM_SETPOS, 1, APosition);
    Changed;
  end;
end;

procedure TsTrackBar.SetPosition(Value: Integer);
begin
  SetParams(Value, FMin, FMax);
end;

procedure TsTrackBar.SetMin(Value: Integer);
begin
  if Value <= FMax then SetParams(FPosition, Value, FMax);
end;

procedure TsTrackBar.SetMax(Value: Integer);
begin
  if Value >= FMin then SetParams(FPosition, FMin, Value);
end;

procedure TsTrackBar.SetFrequency(Value: Integer);
begin
  if Value <> FFrequency then begin
    FFrequency := Value;
    if HandleAllocated then
      SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  end;
end;

procedure TsTrackBar.SetTick(Value: Integer);
begin
  if HandleAllocated then
    SendMessage(Handle, TBM_SETTIC, 0, Value);
end;

procedure TsTrackBar.SetTickStyle(Value: TTickStyle);
begin
  if Value <> FTickStyle then begin
    FTickStyle := Value;
    RecreateWnd;
  end;
end;

procedure TsTrackBar.SetTickMarks(Value: TTickMark);
begin
  if Value <> FTickMarks then begin
    FTickMarks := Value;
    RecreateWnd;
  end;
end;

procedure TsTrackBar.SetLineSize(Value: Integer);
begin
  if Value <> FLineSize then begin
    FLineSize := Value;
    if HandleAllocated then SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
  end;
end;

procedure TsTrackBar.SetPageSize(Value: Integer);
begin
  if Value <> FPageSize then begin
    FPageSize := Value;
    if HandleAllocated then SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
  end;
end;

procedure TsTrackBar.SetThumbLength(Value: Integer);
begin
  if Value <> FThumbLength then begin
    FThumbLength := Value;
    if HandleAllocated then SendMessage(Handle, TBM_SETTHUMBLENGTH, Value, 0);
  end;
end;

procedure TsTrackBar.SetSliderVisible(Value: Boolean);
begin
  if FSliderVisible <> Value then begin
    FSliderVisible := Value;
    RecreateWnd;
  end;
end;

procedure TsTrackBar.UpdateSelection;
begin
  if HandleAllocated then begin
    if (FSelStart = 0) and (FSelEnd = 0) then
      SendMessage(Handle, TBM_CLEARSEL, 1, 0)
    else
      SendMessage(Handle, TBM_SETSEL, Integer(True), MakeLong(FSelStart, FSelEnd));
  end;
end;

procedure TsTrackBar.SetSelStart(Value: Integer);
begin
  if Value <> FSelStart then begin
    FSelStart := Value;
    UpdateSelection;
  end;
end;

procedure TsTrackBar.SetSelEnd(Value: Integer);
begin
  if Value <> FSelEnd then begin
    FSelEnd := Value;
    UpdateSelection;
  end;
end;

procedure TsTrackBar.Changed;
begin
  PaintThumb(Position);
  if not RestrictDrawing then sStyle.BGChanged := True;
  PaintFromCache(ThumbRect);
//  sStyle.Invalidate;
  if Assigned(FOnChange) then FOnChange(Self);
end;

destructor TsTrackBar.Destroy;
begin