gr32_rangebars.pas

skin components for design of your applicastions

    HandleSz := Round(ClientSz * WinSz / Range);

    if HandleSz < MIN_SIZE then Delta := Round(Delta * (Range - WinSz) / (ClientSz - MIN_SIZE))
    else Delta := Delta * Range / ClientSz;

    GenChange := True;
    Position := PosBeforeDrag + Delta;
    GenChange := False;
  end;
end;

procedure TCustomRangeBar.Resize;
var
  OldWindow: Integer;
  Center: Single;
begin
  if Centered then
  begin
    OldWindow := EffectiveWindow;
    UpdateEffectiveWindow;
    if Range > EffectiveWindow then
    begin
      if Range > OldWindow then Center := (FPosition + OldWindow * 0.5) / Range
      else Center := 0.5;
      FPosition := Center * Range - EffectiveWindow * 0.5;
    end;
  end;
  AdjustPosition;
  inherited;
end;

procedure TCustomRangeBar.SetParams(NewRange, NewWindow: Integer);
var
  OldWindow, OldRange: Integer;
  Center: Single;
begin
  if NewRange < 0 then NewRange := 0;
  if NewWindow < 0 then NewWindow := 0;
  if (NewRange <> FRange) or (NewWindow <> EffectiveWindow) then
  begin
    OldWindow := EffectiveWindow;
    OldRange := Range;
    FRange := NewRange;
    FWindow := NewWindow;
    UpdateEffectiveWindow;
    if Centered and (Range > EffectiveWindow) then
    begin
      if (OldRange > OldWindow) and (OldRange <> 0) then
        Center := (FPosition + OldWindow * 0.5) / OldRange
      else
        Center := 0.5;
      FPosition := Center * Range - EffectiveWindow * 0.5;
    end;
    AdjustPosition;
    Invalidate;
  end;
end;

procedure TCustomRangeBar.SetPosition(Value: Single);
var
  OldPosition: Single;
begin
  if Value <> FPosition then
  begin
    OldPosition := FPosition;
    FPosition := Value;
    AdjustPosition;
    if OldPosition <> FPosition then
    begin
      Invalidate;
      DoChange;
    end;
  end;
end;

procedure TCustomRangeBar.SetRange(Value: Integer);
begin
  SetParams(Value, Window);
end;

procedure TCustomRangeBar.SetWindow(Value: Integer);
begin
  SetParams(Range, Value);
end;

procedure TCustomRangeBar.TimerHandler(Sender: TObject);
var
  OldPosition: Single;
  Pt: TPoint;

  function MousePos: TPoint;
  begin
    Result := ScreenToClient(Mouse.CursorPos);
    if Result.X < 0 then Result.X := 0;
    if Result.Y < 0 then Result.Y := 0;
    if Result.X >= ClientWidth then Result.X := ClientWidth - 1;
    if Result.Y >= ClientHeight then Result.Y := ClientHeight - 1
  end;

begin
  inherited;
  GenChange := True;
  OldPosition := Position;

  case DragZone of
    zBtnPrev:
      begin
        Position := Position - Increment;
        if Position = OldPosition then StopDragTracking;
      end;

    zBtnNext:
      begin
        Position := Position + Increment;
        if Position = OldPosition then StopDragTracking;
      end;

    zTrackNext:
      begin
        Pt := MousePos;
        if GetZone(Pt.X, Pt.Y) in [zTrackNext, zBtnNext] then
        Position := Position + EffectiveWindow;
      end;

    zTrackPrev:
      begin
        Pt := MousePos;
        if GetZone(Pt.X, Pt.Y) in [zTrackPrev, zBtnPrev] then
        Position := Position - EffectiveWindow;
      end;
  end;
  GenChange := False;
end;

procedure TCustomRangeBar.UpdateEffectiveWindow;
begin
  if FWindow > 0 then FEffectiveWindow := FWindow
  else
  begin
    if Kind = sbHorizontal then FEffectiveWindow := Width
    else FEffectiveWindow := Height;
  end;
end;

//----------------------------------------------------------------------------//

{ TCustomGaugeBar }

procedure TCustomGaugeBar.AdjustPosition;
begin
  if Position < Min then Position := Min
  else if Position > Max then Position := Max;
end;

constructor TCustomGaugeBar.Create(AOwner: TComponent);
begin
  inherited;
  FLargeChange := 1;
  FMax := 100;
  FSmallChange := 1;
end;

function TCustomGaugeBar.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; {$IFDEF CLX}const{$ENDIF} MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  if not Result then Position := Position + FSmallChange * WheelDelta div 120;
  Result := True;
end;

function TCustomGaugeBar.GetHandleRect: TRect;
var
  Sz, HandleSz: Integer;
  Horz: Boolean;
  Pos: Integer;
begin
  Result := GetTrackBoundary;
  Horz := Kind = sbHorizontal;
  HandleSz := GetHandleSize;

  if Horz then Sz := Result.Right - Result.Left
  else Sz := Result.Bottom - Result.Top;


  Pos := Round((Position - Min) * (Sz - GetHandleSize) / (Max - Min));

  if Horz then
  begin
    Inc(Result.Left, Pos);
    Result.Right := Result.Left + HandleSz;
  end
  else
  begin
    Inc(Result.Top, Pos);
    Result.Bottom := Result.Top + HandleSz;
  end;
end;

function TCustomGaugeBar.GetHandleSize: Integer;
var
  R: TRect;
  Sz: Integer;
begin
  Result := HandleSize;
  if Result = 0 then
  begin
    if Kind = sbHorizontal then Result := ClientHeight else Result := ClientWidth;
  end;
  R := GetTrackBoundary;
  if Kind = sbHorizontal then Sz := R.Right - R.Left
  else Sz := R.Bottom - R.Top;
  if Sz - Result < 1 then Result := Sz - 1;
  if Result < 0 then Result := 0;
end;

procedure TCustomGaugeBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if DragZone = zHandle then
  begin
    StopDragTracking;
    PosBeforeDrag := Position;
  end;
end;

procedure TCustomGaugeBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Delta: Single;
  R: TRect;
  ClientSz: Integer;
begin
  inherited;
  if DragZone = zHandle then
  begin
    if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;
    R := GetTrackBoundary;

    if Kind = sbHorizontal then ClientSz := R.Right - R.Left
    else ClientSz := R.Bottom - R.Top;

    Delta := Delta * (Max - Min) / (ClientSz - GetHandleSize);

    GenChange := True;
    Position := Round(PosBeforeDrag + Delta);
    GenChange := False;
  end;
end;

procedure TCustomGaugeBar.SetHandleSize(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if Value <> FHandleSize then
  begin
    FHandleSize := Value;
    Invalidate;
  end;
end;

procedure TCustomGaugeBar.SetLargeChange(Value: Integer);
begin
  if Value < 1 then Value := 1;
  FLargeChange := Value;
end;

procedure TCustomGaugeBar.SetMax(Value: Integer);
begin
  if (Value <= FMin) and not (csLoading in ComponentState) then Value := FMin + 1;
  if Value <> FMax then
  begin
    FMax := Value;
    AdjustPosition;
    Invalidate;
  end;
end;

procedure TCustomGaugeBar.SetMin(Value: Integer);
begin
  if (Value >= FMax) and not (csLoading in ComponentState) then Value := FMax - 1;
  if Value <> FMin then
  begin
    FMin := Value;
    AdjustPosition;
    Invalidate;
  end;
end;

procedure TCustomGaugeBar.SetPosition(Value: Integer);
begin
  if Value < Min then Value := Min
  else if Value > Max then Value := Max;
  if Round(FPosition) <> Value then
  begin
    FPosition := Value;
    Invalidate;
    DoChange;
  end;
end;

procedure TCustomGaugeBar.SetSmallChange(Value: Integer);
begin
  if Value < 1 then Value := 1;
  FSmallChange := Value;
end;

procedure TCustomGaugeBar.TimerHandler(Sender: TObject);
var
  OldPosition: Single;
  Pt: TPoint;

  function MousePos: TPoint;
  begin
    Result := ScreenToClient(Mouse.CursorPos);
    if Result.X < 0 then Result.X := 0;
    if Result.Y < 0 then Result.Y := 0;
    if Result.X >= ClientWidth then Result.X := ClientWidth - 1;
    if Result.Y >= ClientHeight then Result.Y := ClientHeight - 1
  end;

begin
  inherited;
  GenChange := True;
  OldPosition := Position;

  case DragZone of
    zBtnPrev:
      begin
        Position := Position - SmallChange;
        if Position = OldPosition then StopDragTracking;
      end;

    zBtnNext:
      begin
        Position := Position + SmallChange;
        if Position = OldPosition then StopDragTracking;
      end;

    zTrackNext:
      begin
        Pt := MousePos;
        if GetZone(Pt.X, Pt.Y) in [zTrackNext, zBtnNext] then
        Position := Position + LargeChange;
      end;

    zTrackPrev:
      begin
        Pt := MousePos;
        if GetZone(Pt.X, Pt.Y) in [zTrackPrev, zBtnPrev] then
        Position := Position - LargeChange;
      end;
  end;
  GenChange := False;
end;

{ TArrowBarAccess }

function TArrowBarAccess.GetBackgnd: TRBBackgnd;
begin
  Result := FMaster.Backgnd;
end;

function TArrowBarAccess.GetButtonSize: Integer;
begin
  Result := FMaster.ButtonSize;
end;

function TArrowBarAccess.GetColor: TColor;
begin
  Result := FMaster.Color;
end;

function TArrowBarAccess.GetHandleColor: TColor;
begin
  Result := FMaster.HandleColor;
end;

function TArrowBarAccess.GetHighLightColor: TColor;
begin
  Result := FMaster.HighLightColor;
end;

function TArrowBarAccess.GetShadowColor: TColor;
begin
  Result := FMaster.ShadowColor;
end;

function TArrowBarAccess.GetButtonColor: TColor;
begin
  Result := FMaster.ButtonColor;
end;

function TArrowBarAccess.GetBorderColor: TColor;
begin
  Result := FMaster.BorderColor;
end;

function TArrowBarAccess.GetShowArrows: Boolean;
begin
  Result := FMaster.ShowArrows;
end;

function TArrowBarAccess.GetShowHandleGrip: Boolean;
begin
  Result := FMaster.ShowHandleGrip;
end;

function TArrowBarAccess.GetStyle: TRBStyle;
begin
  Result := FMaster.Style;
end;

procedure TArrowBarAccess.SetBackgnd(Value: TRBBackgnd);
begin
  FMaster.Backgnd := Value;
  if FSlave <> nil then FSlave.Backgnd := Value;
end;

procedure TArrowBarAccess.SetButtonSize(Value: Integer);
begin
  FMaster.ButtonSize := Value;
  if FSlave <> nil then FSlave.ButtonSize := Value;
end;

procedure TArrowBarAccess.SetColor(Value: TColor);
begin
  FMaster.Color := Value;
  if FSlave <> nil then FSlave.Color := Value;
end;

procedure TArrowBarAccess.SetHandleColor(Value: TColor);
begin
  FMaster.HandleColor := Value;
  if FSlave <> nil then FSlave.HandleColor := Value;
end;

procedure TArrowBarAccess.SetHighLightColor(Value: TColor);
begin
  FMaster.HighLightColor := Value;
  if FSlave <> nil then FSlave.HighLightColor := Value;
end;

procedure TArrowBarAccess.SetShadowColor(Value: TColor);
begin
  FMaster.ShadowColor := Value;
  if FSlave <> nil then FSlave.ShadowColor := Value;
end;

procedure TArrowBarAccess.SetButtonColor(Value: TColor);
begin
  FMaster.ButtonColor := Value;
  if FSlave <> nil then FSlave.ButtonColor := Value;
end;

procedure TArrowBarAccess.SetBorderColor(Value: TColor);
begin
  FMaster.BorderColor := Value;
  if FSlave <> nil then FSlave.BorderColor := Value;
end;

procedure TArrowBarAccess.SetShowArrows(Value: Boolean);
begin
  FMaster.ShowArrows := Value;
  if FSlave <> nil then FSlave.ShowArrows := Value;
end;

procedure TArrowBarAccess.SetShowHandleGrip(Value: Boolean);
begin
  FMaster.ShowHandleGrip := Value;
  if FSlave <> nil then FSlave.ShowHandleGrip := Value;
end;

procedure TArrowBarAccess.SetStyle(Value: TRBStyle);
begin
  FMaster.Style := Value;
  if FSlave <> nil then FSlave.Style := Value;
end;

end.