jvqxslider.pas

East make Tray Icon in delphi

  R := SliderRect;
  if Orientation = soVertical then
    Offset := ClientHeight - Offset - FImages[siVThumb].Height;
  Range := MaxValue - MinValue;
  Result := Round((Offset - R.Left - Indent) * Range / GetRulerLength);
  if not (soSmooth in Options) then
    Result := Round(Result / Increment) * Increment;
  Result := Min(MinValue + Max(Result, 0), MaxValue);
end;

function TJvCustomSlider.GetOffsetByValue(Value: Longint): Integer;
var
  Range: Double;
  R: TRect;
  MinIndent: Integer;
begin
  R := SliderRect;
  Range := MaxValue - MinValue;
  if Orientation = soHorizontal then
    MinIndent := R.Left + Indent
  else
    MinIndent := R.Top + Indent;
  Result := Round((Value - MinValue) / Range * GetRulerLength) + MinIndent;
  if Orientation = soVertical then
    Result := R.Top + R.Bottom - Result - FImages[siVThumb].Height;
  Result := Max(Result, MinIndent);
end;

function TJvCustomSlider.GetThumbPosition(var Offset: Integer): TPoint;
var
  R: TRect;
  MinIndent: Integer;
begin
  R := SliderRect;
  if Orientation = soHorizontal then
    MinIndent := R.Left + Indent
  else
    MinIndent := R.Top + Indent;
  Offset := Min(GetOffsetByValue(GetValueByOffset(Min(Max(Offset, MinIndent),
    MinIndent + GetRulerLength))), MinIndent + GetRulerLength);
  if Orientation = soHorizontal then
  begin
    Result.X := Offset;
    Result.Y := FThumbRect.Top;
  end
  else
  begin
    Result.Y := Offset;
    Result.X := FThumbRect.Left;
  end;
end;

function TJvCustomSlider.GetThumbOffset: Integer;
begin
  if Orientation = soHorizontal then
    Result := FThumbRect.Left
  else
    Result := FThumbRect.Top;
end;

procedure TJvCustomSlider.InvalidateThumb;
begin
  if HandleAllocated then
    InvalidateRect(Handle, @FThumbRect, not (csOpaque in ControlStyle));
end;

procedure TJvCustomSlider.SetThumbOffset(Value: Integer);
var
  ValueBefore: Longint;
  P: TPoint;
begin
  ValueBefore := FValue;
  P := GetThumbPosition(Value);
  InvalidateThumb;
  FThumbRect := Bounds(P.X, P.Y, RectWidth(FThumbRect), RectHeight(FThumbRect));
  InvalidateThumb;
  if FSliding then
  begin
    FValue := GetValueByOffset(Value);
    if ValueBefore <> FValue then
      Change;
  end;
end;

function TJvCustomSlider.GetRulerLength: Integer;
begin
  if Orientation = soHorizontal then
  begin
    Result := FRuler.Width;
    Dec(Result, FImages[siHThumb].Width div NumThumbStates);
  end
  else
  begin
    Result := FRuler.Height;
    Dec(Result, FImages[siVThumb].Height);
  end;
end;

procedure TJvCustomSlider.SetValue(Value: Longint);
var
  ValueChanged: Boolean;
begin
  if Value > MaxValue then
    Value := MaxValue;
  if Value < MinValue then
    Value := MinValue;
  ValueChanged := FValue <> Value;
  FValue := Value;
  ThumbOffset := GetOffsetByValue(Value);
  if ValueChanged then
    Change;
end;

procedure TJvCustomSlider.SetReadOnly(Value: Boolean);
begin
  if FReadOnly <> Value then
  begin
    if Value then
    begin
      StopTracking;
      if FSliding then
        ThumbMouseUp(mbLeft, [], 0, 0);
    end;
    FReadOnly := Value;
  end;
end;

procedure TJvCustomSlider.ThumbJump(Jump: TJumpMode);
var
  NewValue: Longint;
begin
  if Jump <> jmNone then
  begin
    case Jump of
      jmHome:
        NewValue := MinValue;
      jmPrior:
        NewValue := (Round(Value / Increment) * Increment) - Increment;
      jmNext:
        NewValue := (Round(Value / Increment) * Increment) + Increment;
      jmEnd:
        NewValue := MaxValue;
    else
      Exit;
    end;
    if NewValue >= MaxValue then
      NewValue := MaxValue
    else
    if NewValue <= MinValue then
      NewValue := MinValue;
    if (NewValue <> Value) then
      Value := NewValue;
  end;
end;

function TJvCustomSlider.JumpTo(X, Y: Integer): TJumpMode;
begin
  Result := jmNone;
  if Orientation = soHorizontal then
  begin
    if FThumbRect.Left > X then
      Result := jmPrior
    else
    if FThumbRect.Right < X then
      Result := jmNext;
  end
  else
  if Orientation = soVertical then
  begin
    if FThumbRect.Top > Y then
      Result := jmNext
    else
    if FThumbRect.Bottom < Y then
      Result := jmPrior;
  end;
end;


procedure TJvCustomSlider.EnabledChanged;
begin
  inherited EnabledChanged;
  InvalidateThumb;
end;

procedure TJvCustomSlider.DoFocusChanged(Control: TWinControl);
var
  Active: Boolean;
begin
  Active := (Control = Self);
  if Active <> FFocused then
  begin
    FFocused := Active;
    if (soShowFocus in Options) then
      Invalidate;
  end;
  inherited DoFocusChanged(Control);
end;

procedure TJvCustomSlider.DoGetDlgCode(var Code: TDlgCodes);
begin
  Code := [dcWantArrows];
end;

procedure TJvCustomSlider.DoBoundsChanged;
begin
  inherited DoBoundsChanged;
  if not (csReading in ComponentState) then
    Sized;
end;


procedure TJvCustomSlider.StopTracking;
begin
  if FTracking then
  begin
    if FTimerActive then
    begin
      KillTimer(Handle, 1);
      FTimerActive := False;
    end;
    FTracking := False;
    MouseCapture := False;
    Changed;
  end;
end;

procedure TJvCustomSlider.TimerTrack;
var
  Jump: TJumpMode;
begin
  Jump := JumpTo(FMousePos.X, FMousePos.Y);
  if Jump = FStartJump then
  begin
    ThumbJump(Jump);
    if not FTimerActive then
    begin
      SetTimer(Handle, 1, JumpInterval, nil);
      FTimerActive := True;
    end;
  end;
end;

procedure TJvCustomSlider.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Rect: TRect;
  P: TPoint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and not (ssDouble in Shift) then
  begin
    if CanFocus then
      SetFocus;
    P := Point(X, Y);
    if PtInRectInclusive(FThumbRect,P) then
      ThumbMouseDown(Button, Shift, X, Y)
    else
    begin
      with FRulerOrg, FRuler do
        Rect := Bounds(X, Y, Width, Height);
      InflateRect(Rect, Ord(Orientation = soVertical) * 3,
        Ord(Orientation = soHorizontal) * 3);
      if PtInRectInclusive(Rect, P) and CanModify and not ReadOnly then
      begin
        MouseCapture := True;
        FTracking := True;
        FMousePos := P;
        FStartJump := JumpTo(X, Y);
        TimerTrack;
      end;
    end;
  end;
end;

procedure TJvCustomSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if (csLButtonDown in ControlState) and FSliding then
    ThumbMouseMove(Shift, X, Y)
  else
  if FTracking then
    FMousePos := Point(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TJvCustomSlider.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  StopTracking;
  if FSliding then
    ThumbMouseUp(Button, Shift, X, Y);
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TJvCustomSlider.KeyDown(var Key: Word; Shift: TShiftState);
var
  Jump: TJumpMode;
begin
  Jump := jmNone;
  if Shift = [] then
  begin
    if Key = VK_HOME then
      Jump := jmHome
    else
    if Key = VK_END then
      Jump := jmEnd;
    if Orientation = soHorizontal then
    begin
      if Key = VK_LEFT then
        Jump := jmPrior
      else
      if Key = VK_RIGHT then
        Jump := jmNext;
    end
    else
    begin
      if Key = VK_UP then
        Jump := jmNext
      else
      if Key = VK_DOWN then
        Jump := jmPrior;
    end;
  end;
  if (Jump <> jmNone) and CanModify and not ReadOnly then
  begin
    Key := 0;
    ThumbJump(Jump);
    Changed;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TJvCustomSlider.ThumbMouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if CanFocus then
    SetFocus;
  if (Button = mbLeft) and CanModify and not ReadOnly then
  begin
    FSliding := True;
    FThumbDown := True;
    if Orientation = soHorizontal then
      FHit := X - FThumbRect.Left
    else
      FHit := Y - FThumbRect.Top;
    InvalidateThumb;
    Update;
  end;
end;

procedure TJvCustomSlider.ThumbMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if (csLButtonDown in ControlState) and CanModify and not ReadOnly then
  begin
    if Orientation = soHorizontal then
      ThumbOffset := X - FHit
    else
      ThumbOffset := Y - FHit;
  end;
end;

procedure TJvCustomSlider.ThumbMouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) then
  begin
    FSliding := False;
    FThumbDown := False;
    InvalidateThumb;
    Update;
    if CanModify and not ReadOnly then
      Changed;
  end;
end;

//=== TJvCustomTrackBar ======================================================

constructor TJvCustomTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImages := TJvSliderImages.Create;
  FImages.FSlider := Self;
end;

destructor TJvCustomTrackBar.Destroy;
begin
  FImages.Free;
  inherited Destroy;
end;

//=== TJvSliderImages ========================================================

function TJvSliderImages.GetImage(Index: Integer): TBitmap;
begin
  Result := FSlider.GetImage(Index);
end;

procedure TJvSliderImages.SetImage(Index: Integer; Value: TBitmap);
begin
  FSlider.SetImage(Index, Value);
end;

function TJvSliderImages.StoreImage(Index: Integer): Boolean;
begin
  Result := FSlider.StoreImage(Index);
end;

function TJvSliderImages.GetNumThumbStates: TNumThumbStates;
begin
  Result := FSlider.NumThumbStates;
end;

procedure TJvSliderImages.SetNumThumbStates(Value: TNumThumbStates);
begin
  FSlider.NumThumbStates := Value;
end;

function TJvSliderImages.GetEdgeSize: Integer;
begin
  Result := FSlider.EdgeSize;
end;

procedure TJvSliderImages.SetEdgeSize(Value: Integer);
begin
  FSlider.EdgeSize := Value;
end;

end.