slider.pas

一个非常好用的MP3音乐播放控件

unit Slider;

interface

uses 
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs; 

type 
  TSliderOrientation = (slHorizontal, slVertical);
  TSlider = class(TCustomControl) 
  private

    Highlighted: boolean;
    Tracking: boolean;
    TrackingPoint: TPoint;
    TrackingPosition: Integer;
    ScratchPad: TBitmap;
    ThumbBounds: TRect;

    fThumbNormal: TBitmap;
    fThumbHighlighted: TBitmap;
    fThumbClicked: TBitmap;
    fTrack: TBitmap;
    fOrientation: TSliderOrientation;
    fMin: Integer;
    fMax: Integer;
    fPosition: Integer;
    fOnChange: TNotifyEvent;
    procedure SetThumbNormal(thumb: TBitmap);
    procedure SetThumbHighlighted(thumb: TBitmap);
    procedure SetThumbClicked(thumb: TBitmap);
    procedure SetTrack(track: TBitmap);
    procedure SetOrientation(orientation: TSliderOrientation);
    procedure SetMin(min: Integer);
    procedure SetMax(max: Integer);
    procedure SetPosition(position: Integer);

  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Draw;
    procedure ComputeImage;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property ThumbNormal: TBitmap read fThumbNormal write SetThumbNormal;
    property ThumbHighlighted: TBitmap read fThumbHighlighted write SetThumbHighlighted;
    property ThumbClicked: TBitmap read fThumbClicked write SetThumbClicked;
    property Track: TBitmap read fTrack write SetTrack;
    property Orientation: TSliderOrientation read fOrientation write SetOrientation;
    property Minimum: Integer read fMin write SetMin;
    property Maximum: Integer read fMax write SetMax;
    property Position: Integer read fPosition write SetPosition;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;

    property Enabled;
    property HelpContext;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property Tag;
    property Visible;

    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

  end;

implementation

constructor TSlider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 0;
  Height := 0;
  ScratchPad := TBitmap.Create;
  Highlighted := False;
  Tracking := False;
  ThumbBounds.Left := 0;
  ThumbBounds.Right := 0;
  ThumbBounds.Top := 0;
  ThumbBounds.Bottom := 0;
  fThumbNormal := Nil;
  fThumbHighlighted := Nil;
  fThumbClicked := Nil;
  fTrack := Nil;
  fOrientation := slHorizontal;
  fMin := 0;
  fMax := 100;
  fPosition := 0;
  fOnChange := Nil;
end;

destructor TSlider.Destroy;
begin
  if fThumbNormal <> nil then fThumbNormal.Free;
  if fThumbHighlighted <> nil then fThumbHighlighted.Free;
  if fThumbClicked <> nil then fThumbClicked.Free;
  if fTrack <> nil then fTrack.Free;
  ScratchPad.Free;
  inherited Destroy
end;

procedure TSlider.SetThumbNormal(thumb: TBitmap);
begin
  if fThumbNormal <> nil then fThumbNormal.Free;
  fThumbNormal := TBitmap.Create;
  fThumbNormal.Assign(thumb);
  if fThumbHighlighted = nil then SetThumbHighlighted(thumb);
  if ThumbClicked = nil then SetThumbClicked(thumb);
  ScratchPad.Height := thumb.Height;
  ComputeImage;
end;

procedure TSlider.SetThumbHighlighted(thumb: TBitmap);
begin
  if fThumbHighlighted <> nil then fThumbHighlighted.Free;
  fThumbHighlighted := TBitmap.Create;
  fThumbHighlighted.Assign(thumb);
  ComputeImage;
end;

procedure TSlider.SetThumbClicked(thumb: TBitmap);
begin
  if fThumbClicked <> nil then fThumbClicked.Free;
  fThumbClicked := TBitmap.Create;
  fThumbClicked.Assign(thumb);
  ComputeImage;
end;

procedure TSlider.SetTrack(track: TBitmap);
begin
  if fTrack <> nil then fTrack.Free;
  fTrack := TBitmap.Create;
  fTrack.Assign(track);
  ScratchPad.Width := track.Width;
  ComputeImage;
end;

procedure TSlider.SetOrientation(orientation: TSliderOrientation);
begin
  if orientation <> fOrientation then
  begin
    fOrientation := orientation;
    ComputeImage;
    Invalidate
  end
end;

procedure TSlider.SetMin(min: Integer);
begin
  if min <> fMin then
  begin
    fMin := min;
    if Position < fMin then Position := fMin;
    ComputeImage;
    Invalidate
  end
end;

procedure TSlider.SetMax(max: Integer);
begin
  if max <> fMax then
  begin
    fMax := max;
    if Position > fMax then Position := fMax;
    ComputeImage;
    Invalidate
  end
end;

procedure TSlider.SetPosition(position: Integer);
begin
  if position < Minimum then position := Minimum;
  if position > Maximum then position := Maximum;
  if position <> fPosition then
  begin
    fPosition := position;
    ComputeImage;
    Draw
  end
end;

procedure TSlider.Paint;
begin
  Draw;
end;

procedure TSlider.Draw;
begin
  if csLoading in ComponentState then Exit;
  Canvas.Draw(0, 0, ScratchPad);
end;

procedure TSlider.ComputeImage;
var
  pixelPosition: Integer;
begin
  if Minimum = Maximum then Exit;
  if (fTrack = nil) or (fThumbNormal = nil) then Exit;
  ScratchPad.Canvas.Draw(0, 0, fTrack);
  pixelPosition := ((fPosition - Minimum) * (fTrack.Width - fThumbNormal.Width)) div (Maximum - Minimum);
  ThumbBounds.Left := pixelPosition;
  ThumbBounds.Right := ThumbBounds.Left + fThumbNormal.Width;
  ThumbBounds.Top := 0;
  ThumbBounds.Bottom := fThumbNormal.Width;
  if Highlighted and (not Tracking) then
    ScratchPad.Canvas.Draw(pixelPosition, 0, fThumbHighlighted)
  else if Tracking then
    ScratchPad.Canvas.Draw(pixelPosition, 0, fThumbClicked)
  else
    ScratchPad.Canvas.Draw(pixelPosition, 0, fThumbNormal);
end;

procedure TSlider.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and PtInRect(ThumbBounds, Point(X, Y)) then
  begin
    Tracking := True;
    TrackingPoint := Point(X, Y);
    TrackingPosition := fPosition;
    ComputeImage;
    Draw;
  end;
end;

procedure TSlider.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) then
  begin
    if Tracking then
    begin
      Tracking := False;
      if Position <> TrackingPosition then
      begin
          if Assigned(fOnChange) then OnChange(self);
      end;
      ComputeImage;
      Draw;
    end;
  end;
end;

procedure TSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(shift, X, Y);
  if Tracking then
  begin
    if Orientation = slVertical then
      Position := TrackingPosition + Minimum + (Maximum - Minimum) * (TrackingPoint.Y - Y) div(fTrack.Height - fThumbNormal.Height)
    else
      Position := TrackingPosition + Minimum + (Maximum - Minimum) * (X - TrackingPoint.X) div(fTrack.Width - fThumbNormal.Width);
  end
  else
  begin
    if PtInRect(ThumbBounds, Point(X, Y)) then
    begin
      Highlighted := True;
      ComputeImage;
      Draw;
    end
    else
    begin
      if Highlighted then
      begin
        Highlighted := False;
        ComputeImage;
        Draw;
      end;
    end;
  end;
end;

end.