gr32_rangebars.pas

skin components for design of your applicastions

    if PtInRect(R1, P) then Result := zBtnPrev
    else
    begin
      R1.Right := R.Right;
      R1.Left := R.Right - Sz;
      if PtInRect(R1, P) then Result := zBtnNext;
    end;
  end
  else
  begin
    R1.Bottom := R1.Top + Sz;
    if PtInRect(R1, P) then Result := zBtnPrev
    else
    begin
      R1.Bottom := R.Bottom;
      R1.Top := R.Bottom - Sz;
      if PtInRect(R1, P) then Result := zBtnNext;
    end;
  end;

  if Result = zNone then
  begin
    R := GetHandleRect;
    P := Point(X, Y);
    if PtInRect(R, P) then Result := zHandle
    else
    begin
      if Kind = sbHorizontal then
      begin
        if (X > 0) and (X < R.Left) then Result := zTrackPrev
        else if (X >= R.Right) and (X < ClientWidth - 1) then Result := zTrackNext;
      end
      else
      begin
        if (Y > 0) and (Y < R.Top) then Result := zTrackPrev
        else if (Y >= R.Bottom) and (Y < ClientHeight - 1) then Result := zTrackNext;
      end;
    end;
  end;
end;

function TArrowBar.GetZoneRect(Zone: TRBZone): TRect;
const
  CEmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
var
  BtnSize: Integer;
  Horz: Boolean;
  R: TRect;
begin
  Horz := Kind = sbHorizontal;
  BtnSize:= GetButtonSize;
  case Zone of
    zNone: Result := CEmptyRect;
    zBtnPrev:
      begin
        Result := ClientRect;
        if Horz then Result.Right := Result.Left + BtnSize
        else Result.Bottom := Result.Top + BtnSize;
      end;
    zTrackPrev..zTrackNext:
      begin
        Result := GetTrackBoundary;
        R := GetHandleRect;
        if not DrawEnabled or IsRectEmpty(R) then
        begin
          R.Left := (Result.Left + Result.Right) div 2;
          R.Top := (Result.Top + Result.Bottom) div 2;
          R.Right := R.Left;
          R.Bottom := R.Top;
        end;
        case Zone of
          zTrackPrev:
            if Horz then Result.Right := R.Left
            else Result.Bottom := R.Top;
          zHandle:
            Result := R;
          zTrackNext:
            if Horz then Result.Left := R.Right
            else Result.Top := R.Bottom;
        end;
      end;
    zBtnNext:
      begin
        Result := ClientRect;
        if Horz then Result.Left := Result.Right - BtnSize
        else Result.Top := Result.Bottom - BtnSize;
      end;
  end;
end;

procedure TArrowBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button <> mbLeft then Exit;
  DragZone := GetZone(X, Y);
  Invalidate;
  StoredX := X;
  StoredY := Y;
  StartDragTracking;
end;

procedure TArrowBar.MouseLeft;
begin
  StopHotTracking;
end;

procedure TArrowBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewHotZone: TRBZone;
begin
  inherited;
  if (DragZone = zNone) and DrawEnabled then
  begin
    NewHotZone := GetZone(X, Y);
    if NewHotZone <> HotZone then
    begin
      HotZone := NewHotZone;
      if HotZone <> zNone then StartHotTracking;
      Invalidate;
    end;
  end;
end;

procedure TArrowBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  DragZone := zNone;
  Invalidate;
  StopDragTracking;
end;

procedure TArrowBar.Paint;
const
  CPrevDirs: array [Boolean] of TRBDirection = (drUp, drLeft);
  CNextDirs: array [Boolean] of TRBDirection = (drDown, drRight);
var
  BSize: Integer;
  ShowEnabled: Boolean;
  R, BtnRect, HandleRect: TRect;
  Horz, ShowHandle: Boolean;
begin
  R := ClientRect;
  Horz := Kind = sbHorizontal;
  ShowEnabled := DrawEnabled;
  BSize := GetButtonSize;

  if ShowArrows then
  begin
    { left / top button }
    BtnRect := R;
    with BtnRect do if Horz then Right := Left + BSize else Bottom := Top + BSize;
    DoDrawButton(BtnRect, CPrevDirs[Horz], DragZone = zBtnPrev, ShowEnabled, HotZone = zBtnPrev);

    { right / bottom button }
    BtnRect := R;
    with BtnRect do if Horz then Left := Right - BSize else Top := Bottom - BSize;
    DoDrawButton(BtnRect, CNextDirs[Horz], DragZone = zBtnNext, ShowEnabled, HotZone = zBtnNext);
  end;

  if Horz then InflateRect(R, -BSize, 0) else InflateRect(R, 0, -BSize);
  if ShowEnabled then HandleRect := GetHandleRect
  else HandleRect := Rect(0, 0, 0, 0);
  ShowHandle := not IsRectEmpty(HandleRect);

  DoDrawTrack(GetZoneRect(zTrackPrev), CPrevDirs[Horz], DragZone = zTrackPrev, ShowEnabled, HotZone = zTrackPrev);
  DoDrawTrack(GetZoneRect(zTrackNext), CNextDirs[Horz], DragZone = zTrackNext, ShowEnabled, HotZone = zTrackNext);
  if ShowHandle then DoDrawHandle(HandleRect, Horz, DragZone = zHandle, HotZone = zHandle);
end;

procedure TArrowBar.SetBackgnd(Value: TRBBackgnd);
begin
  if Value <> FBackgnd then
  begin
    FBackgnd := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle := Value;
{$IFDEF CLX}
    Invalidate;
{$ELSE}
    RecreateWnd;
{$ENDIF}
  end;
end;

procedure TArrowBar.SetButtonSize(Value: Integer);
begin
  if Value <> FButtonSize then
  begin
    FButtonSize := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetHandleColor(Value: TColor);
begin
  if Value <> FHandleColor then
  begin
    FHandleColor := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetHighLightColor(Value: TColor);
begin
  if Value <> FHighLightColor then
  begin
    FHighLightColor := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetButtonColor(Value: TColor);
begin
  if Value <> FButtonColor then
  begin
    FButtonColor := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetBorderColor(Value: TColor);
begin
  if Value <> FBorderColor then
  begin
    FBorderColor := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetShadowColor(Value: TColor);
begin
  if Value <> FShadowColor then
  begin
    FShadowColor := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetKind(Value: TScrollBarKind);
var
  Tmp: Integer;
begin
  if Value <> FKind then
  begin
    FKind := Value;
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    begin
      Tmp := Width;
      Width := Height;
      Height := Tmp;
    end;
    Invalidate;
  end;
end;

procedure TArrowBar.SetShowArrows(Value: Boolean);
begin
  if Value <> FShowArrows then
  begin
    FShowArrows := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetShowHandleGrip(Value: Boolean);
begin
  if Value <> FShowHandleGrip then
  begin
    FShowHandleGrip := Value;
    Invalidate;
  end;
end;

procedure TArrowBar.SetStyle(Value: TRBStyle);
begin
  FStyle := Value;
{$IFDEF CLX}
  Invalidate;
{$ELSE}
  RecreateWnd;
{$ENDIF}
end;

procedure TArrowBar.StartDragTracking;
begin
  Timer.Interval := FIRST_DELAY;
  TimerMode := tmScroll;
  TimerHandler(Self);
  TimerMode := tmScrollFirst;
  Timer.Enabled := True;
end;

procedure TArrowBar.StartHotTracking;
begin
  Timer.Interval := HOTTRACK_INTERVAL;
  TimerMode := tmHotTrack;
  Timer.Enabled := True;
end;

procedure TArrowBar.StopDragTracking;
begin
  StartHotTracking;
end;

procedure TArrowBar.StopHotTracking;
begin
  Timer.Enabled := False;
  HotZone := zNone;
  Invalidate;
end;

procedure TArrowBar.TimerHandler(Sender: TObject);
var
  Pt: TPoint;
begin
  case TimerMode of
    tmScrollFirst:
      begin
        Timer.Interval := SCROLL_INTERVAL;
        TimerMode := tmScroll;
      end;
    tmHotTrack:
      begin
        Pt := ScreenToClient(Mouse.CursorPos);
        if not PtInRect(ClientRect, Pt) then
        begin
          StopHotTracking;
          Invalidate;
        end;
      end;
  end;
end;

{$IFNDEF CLX}
procedure TArrowBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := -1;
end;

procedure TArrowBar.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  Sz: Integer;
begin
  Sz := GetBorderSize;
  InflateRect(Message.CalcSize_Params.rgrc[0], -Sz, -Sz);
end;

procedure TArrowBar.WMNCPaint(var Message: TMessage);
begin
  DrawNCArea(0, HRGN(Message.WParam));
end;
{$ELSE}

function TArrowBar.WidgetFlags: Integer;
begin
  Result := Inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase) or
    Integer(WidgetFlags_WResizeNoErase);
end;
{$ENDIF}

{ TCustomRangeBar }

procedure TCustomRangeBar.AdjustPosition;
begin
  if FPosition > Range - EffectiveWindow then FPosition := Range - EffectiveWindow;
  if FPosition < 0 then FPosition := 0;
end;

constructor TCustomRangeBar.Create(AOwner: TComponent);
begin
  inherited;
  FIncrement := 8;
end;

function TCustomRangeBar.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 + Increment * WheelDelta / 120;
  Result := True;
end;

function TCustomRangeBar.DrawEnabled: Boolean;
begin
  Result := Enabled and (Range > EffectiveWindow);
end;

function TCustomRangeBar.GetHandleRect: TRect;
var
  BtnSz, ClientSz: Integer;
  HandleSz, HandlePos: Integer;
  R: TRect;
  Horz: Boolean;
begin
  R := Rect(0, 0, ClientWidth, ClientHeight);
  Horz := Kind = sbHorizontal;
  BtnSz := GetButtonSize;
  if Horz then
  begin
    InflateRect(R, -BtnSz, 0);
    ClientSz := R.Right - R.Left;
  end
  else
  begin
    InflateRect(R, 0, -BtnSz);
    ClientSz := R.Bottom - R.Top;
  end;
  if ClientSz < 18 then
  begin
    Result := Rect(0, 0, 0, 0);
    Exit;
  end;

  if Range > EffectiveWindow then
  begin
    HandleSz := Round(ClientSz * EffectiveWindow / Range);
    if HandleSz >= MIN_SIZE then HandlePos := Round(ClientSz * Position / Range)
    else
    begin
      HandleSz := MIN_SIZE;
      HandlePos := Round((ClientSz - MIN_SIZE) * Position / (Range - EffectiveWindow));
    end;
    Result := R;
    if Horz then
    begin
      Result.Left := R.Left + HandlePos;
      Result.Right := R.Left + HandlePos + HandleSz;
    end
    else
    begin
      Result.Top := R.Top + HandlePos;
      Result.Bottom := R.Top + HandlePos + HandleSz;
    end;
  end
  else Result := R;
end;

function TCustomRangeBar.IsPositionStored: Boolean;
begin
  Result := FPosition > 0;
end;

procedure TCustomRangeBar.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Range <= EffectiveWindow then DragZone := zNone
  else
  begin
    inherited;
    if DragZone = zHandle then
    begin
      StopDragTracking;
      PosBeforeDrag := Position;
    end;
  end;
end;

procedure TCustomRangeBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Delta: Single;
  WinSz: Single;
  ClientSz, HandleSz: Integer;
begin
  inherited;
  if DragZone = zHandle then
  begin
    WinSz := EffectiveWindow;

    if Range <= WinSz then Exit;
    if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;

    if Kind = sbHorizontal then ClientSz := ClientWidth  else ClientSz := ClientHeight;
    Dec(ClientSz, GetButtonSize * 2);
    if BorderStyle = bsSingle then Dec(ClientSz, 2);