unit UnitFrameMySlide;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, Buttons, ComCtrls, StdCtrls, Mask, ExtCtrls;

type
  TMySlide = class(TFrame)
    timdown: TTimer;
    timup: TTimer;
    pnlTop: TPanel;
    btnDropdown: TSpeedButton;
    pnlText: TPanel;
    pnlUpDown: TPanel;
    btnUp: TSpeedButton;
    btnDown: TSpeedButton;
    Edit1: TEdit;
    pnlSlide: TPanel;
    Image1: TImage;
    procedure FrameMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FrameMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //procedure btnUpClick(Sender: TObject);
    procedure btnUpMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btnDownMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnDownMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure timupTimer(Sender: TObject);
    procedure timdownTimer(Sender: TObject);
    procedure btnUpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnUpMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDown2ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure btnDropdownClick(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure pnlSlideMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    //procedure CreateParams(var Params: TCreateParams);override;
    //    procedure PaintWindow(DC: HDC); override;

  private

    dragmode : boolean;
    fposition : integer;
    fMin, fMax, fIncrement : integer;

    { Private declarations }
    procedure SetSlider(position : integer);
    procedure DrawSlider;
    function GetMin : integer;
    procedure SetMin(value : integer);
    function GetMax : integer;
    procedure SetMax(value : integer);
    function GetInc : integer;
    procedure SetInc(value : integer);

    function GetUpDownVisible : boolean;
    procedure SetUpDownVisible(value : Boolean);
    procedure CreateParams(var Params: TCreateParams);override;
     procedure PaintWindow(DC: HDC); override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
  published
    property Position : integer read fPosition write setslider default 1;
    property Min : Integer read GetMin write SetMin default 1;
    property Max : Integer read GetMax write SetMax default 100;
    property Increment : Integer read GetInc write SetInc default 1;
    property UpDownVisible : Boolean read GetUpDownVisible write SetUpDownVisible default true;
  end;

type TJJSlide = class(TMySlide)
  published
    property Position : integer read fPosition write setslider default 1;
    property Min : Integer read GetMin write SetMin default 1;
    property Max : Integer read GetMax write SetMax default 100;
end;

procedure Register;

implementation
uses math;

{$R *.dfm}


procedure Register;
begin
    RegisterComponents('Samples',[TJJSlide]);
end;

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

    //fposition := updown1.position;

    fmin := 1;
    fmax := 100;
    fPosition := 1;
    fIncrement := 1;

    self.SetSlider(fMin);
end;
procedure TMySlide.CreateParams(var Params: TCreateParams);
begin
	{will appear black without doublebuffer = false}
    Brush.Style := bsClear;
   	inherited;

    self.Width := pnlTop.Width;
    self.Height := pnlTop.Height;
end;

 procedure TMySlide.PaintWindow(DC: HDC);
 begin

 end;


function TMySlide.GetMin : integer;
begin
	result := fMin;
end;
procedure TMySlide.SetMin(value : integer);
begin
	fMin := value;
    if fPosition < fMin then fPosition := fMin;
end;
function TMySlide.GetMax : integer;
begin
	result := fMax;
end;
procedure TMySlide.SetMax(value : integer);

begin
	fMax := value;
    if fPosition > fMax then fPosition := fMax;
end;
function TMySlide.GetInc : integer;
begin
    Result := fIncrement;
end;
procedure TMySlide.SetInc(value : integer);
begin
    fIncrement := value;
end;
function TMySlide.GetUpDownVisible : boolean;
begin
    Result := pnlUpDown.Visible;
end;
procedure TMySlide.SetUpDownVisible(value : Boolean);
begin
    pnlUpDown.Visible := value;
    Self.Realign;
    if pnlUpDown.Visible then begin

    end else begin
        pnlTop.Width := pnlTop.Width - pnlUpDown.Width;
    end;
    Self.Width := pnlTop.Width;
end;


{Up and Down buttons including holding down the buttons}
procedure TMySlide.btnDownMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
	timdownTimer(nil);
	timdown.Enabled := true;


end;
procedure TMySlide.btnDownMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
    timdown.Enabled := false;

    if assigned(self.OnClick) then begin
        self.OnClick(sender);
    end;
end;
procedure TMySlide.btnUpMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
	timup.Enabled := false;
    if assigned(self.OnClick) then begin
        self.OnClick(sender);
    end;
end;
procedure TMySlide.btnUpMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
	timupTimer(nil);
	timup.Enabled := true;
end;
procedure TMySlide.timdownTimer(Sender: TObject);
begin
	dec(fposition, fIncrement);
    SetSlider(fposition);
end;
procedure TMySlide.timupTimer(Sender: TObject);
begin
	inc(fposition, fIncrement);
    SetSlider(fposition);
end;


procedure TMySlide.btnUpMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
	self.FrameMouseMove(sender, shift,x,y);
end;





{
procedure TMySlide.CreateParams(var Params: TCreateParams);
begin
	inherited;
  	Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT or WS_EX_COMPOSITED;
end;
{
procedure TMySlide.PaintWindow(DC: HDC);
begin
  //inherited;

end;
}






procedure TMySlide.DrawSlider;
var i : integer;
	thumb : trect;
    dx : double;

begin
    with image1.Canvas do begin
        {background}
        brush.Color := clBtnFace;
        fillrect(image1.ClientRect);

        {notches}
        brush.color := clBtnText;
        for i := 0 to 10 do begin
            thumb.left := round((image1.width-9) * ((i)/9))+4;
            thumb.right := thumb.Left + 1;
            thumb.Top := 4;
            thumb.Bottom := thumb.Top + 3;

            fillrect(thumb);
        end;


        {horizontal line}
        thumb.Top := 10;
        thumb.Bottom := thumb.Top + 4;
        thumb.Left := 4;
        thumb.right := image1.Width-3;
        DrawEdge(image1.Canvas.Handle, thumb,BDR_SUNKENOUTER,BF_RECT);

        {thumb}
        pen.Color := cl3DDkShadow;
        brush.color := clBtnShadow;

        dx := math.max((fposition-fMin),1) / (fMax-fMin);

        thumb.Left := math.max(0,round(image1.Width * dx) - 3);
        thumb.Left := math.min(image1.Width - 6, thumb.left);

        thumb.right := thumb.Left + 5;
        thumb.top := 8;
        thumb.Bottom := thumb.top + 8;

        Rectangle(thumb);
    end;
end;

procedure TMySlide.Edit1Change(Sender: TObject);
begin
    try
        fposition := strtoint(edit1.text);
    except

    end;
end;

procedure TMySlide.Edit1Click(Sender: TObject);
begin
    edit1.SelectAll;
end;

procedure TMySlide.Edit1Exit(Sender: TObject);
var i : integer;
begin
    try
        i := StrToInt(Edit1.text);
        if i < fmin then begin
            i := fmin;
        end else if i > fmax then begin
        	i := fMax;
        end;

        self.SetSlider(i); 
    except
        Edit1.text := IntToSTr(fMin);
    end;
end;

procedure TMySlide.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
	if key = #13 then begin
    	key := #0 ;
        self.Edit1Exit(sender);
    end;
end;

procedure TMySlide.SetSlider(position: integer);
begin
    position := math.max(fmin, position);
    position := math.min(fMax, position);
    
	//Label1.Caption := IntToStr(position);
    edit1.text := IntToStr(position);
    //UpDown1.Position := position;
    fposition := position;
end;

procedure TMySlide.btnDropdownClick(Sender: TObject);
begin
	if not dragmode then begin
        //zorder := self.TabOrder;
        //self.taborder := 1;
        self.Height := pnlText.Height + pnlSlide.Height+5;
        self.Width := pnlSlide.Width + 16;

        self.BringToFront;
        self.SetFocus;
        dragmode := true;

        //self.FrameMouseMove(nil,[],0,0);
        self.DrawSlider;
        self.Edit1.Enabled := false;
    end else begin
    	FrameMouseDown(nil,mbLeft,[],0,0);
    end;

    btnDropdown.AllowAllUp := true;
    btnDropdown.Down := dragmode;
end;


procedure TMySlide.FrameMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var pt : TPoint;
	i, wd : integer;
const
	left_margin = 0;
    right_margin = 0;
begin
	if dragmode then begin
        pt := image1.ScreenToClient(mouse.CursorPos);

        if pt.X < left_margin then pt.x := left_margin;
        if pt.X > image1.Width - right_margin then pt.x := image1.Width - right_margin;

        pt.x := pt.x - left_margin;
        wd := image1.Width - left_margin - right_margin;

        i := floor((fmax - fmin) * (pt.x/wd) + fmin);


        self.SetSlider(i);
        image1.Enabled := false;

        self.DrawSlider;
    end;
end;
procedure TMySlide.FrameMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   	dragmode := false;
	//self.SendToBack;
    self.Height := pnlTop.Height;
    self.Width := pnlTop.Width;
    //self.TabOrder := zorder;

    btnDropdown.Down := dragmode;
    self.Edit1.Enabled := true;

    //self.SetFocus;
end;
procedure TMySlide.pnlSlideMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if assigned(self.OnClick) then begin
        self.OnClick(sender);
    end;
end;

procedure TMySlide.UpDown2ChangingEx(Sender: TObject; var AllowChange: Boolean;
  NewValue: Smallint; Direction: TUpDownDirection);
begin
    fposition := NewValue;
    edit1.Text := inttostr(fposition);
    
    allowchange := true;
end;

end.
