gr32_rangebars.pas

skin components for design of your applicastions

  TopRight, BottomLeft: TPoint;
begin
  with Canvas, ARect do
  begin
    Pen.Width := 1;
    Dec(Bottom); Dec(Right);
    TopRight.X := Right;
    TopRight.Y := Top;
    BottomLeft.X := Left;
    BottomLeft.Y := Bottom;
    Pen.Color := TopColor;
    PolyLine([BottomLeft, TopLeft, TopRight]);
    Pen.Color := BottomColor;
    Dec(Left);
    PolyLine([TopRight, BottomRight, BottomLeft]);
    if AdjustRect then
    begin
      Inc(Top); Inc(Left, 2);
    end
    else
    begin
      Inc(Left); Inc(Bottom); Inc(Right);
    end;
  end;
end;

procedure DrawHandle(Canvas: TCanvas; R: TRect; Color: TColor;
  Pushed, ShowGrip, IsHorz: Boolean; ColorBorder: TColor);
var
  CHi, CLo: TColor;
  I, S: Integer;
begin
  CHi := ClrLighten(Color, 24);
  CLo := ClrLighten(Color, -24);

{$IFDEF CLX}
  Canvas.Pen.Color := ColorBorder;  // CLX FrameRect function is using Pen instead of Brush
  FrameRect(Canvas, R);
{$ELSE}
  Canvas.Brush.Color := ColorBorder;
  FrameRect(Canvas.Handle, R, Canvas.Brush.Handle);
{$ENDIF}

  InflateRect(R, -1, -1);
  if Pushed then Frame3D(Canvas, R, CLo, Color)
  else Frame3D(Canvas, R, CHi, MixColors(ColorBorder, Color, 96));
  Canvas.Brush.Color := Color;
  Canvas.FillRect(R);

  if ShowGrip then
  begin
    if Pushed then OffsetRect(R, 1, 1);
    if IsHorz then
    begin
      S := R.Right - R.Left;
      R.Left := (R.Left + R.Right) div 2 - 5;
      R.Right := R.Left + 2;
      Inc(R.Top); Dec(R.Bottom);

      if S > 10 then Frame3D(Canvas, R, CHi, CLo, False);
      Inc(R.Left, 3); Inc(R.Right, 3);
      Frame3D(Canvas, R, CHi, CLo, False);
      Inc(R.Left, 3); Inc(R.Right, 3);
      Frame3D(Canvas, R, CHi, CLo, False);
      Inc(R.Left, 3); Inc(R.Right, 3);
      if S > 10 then Frame3D(Canvas, R, CHi, CLo, False);
    end
    else
    begin
      I := (R.Top + R.Bottom) div 2;
      S := R.Bottom - R.Top;
      R.Top := I - 1;
      R.Bottom := I + 1;
      Dec(R.Right);
      Inc(R.Left);

      OffsetRect(R, 0, -4);
      if S > 10 then
      begin
        Frame3D(Canvas, R, CHi, CLo, False);
      end;

      OffsetRect(R, 0, 3);
      Frame3D(Canvas, R, CHi, CLo, False);

      OffsetRect(R, 0, 3);
      Frame3D(Canvas, R, CHi, CLo, False);

      if S > 10 then
      begin
        OffsetRect(R, 0, 3);
        Frame3D(Canvas, R, CHi, CLo, False);
      end;
    end;
  end;
end;

procedure DrawArrow(Canvas: TCanvas; R: TRect; Direction: TRBDirection; Color: TColor);
var
  X, Y, Sz, Shift: Integer;
begin
  X := (R.Left + R.Right - 1) div 2;
  Y := (R.Top + R.Bottom - 1) div 2;
  Sz := (Min(X - R.Left, Y - R.Top)) * 3 div 4 - 1;
  if Sz = 0 then Sz := 1;
  if Direction in [drUp, drLeft] then Shift := (Sz + 1) * 1 div 3
  else Shift := Sz * 1 div 3;
  Canvas.Pen.Color := Color;
  Canvas.Brush.Color := Color;
  case Direction of
    drUp:
      begin
        Inc(Y, Shift);
        Canvas.Polygon([Point(X + Sz, Y), Point(X, Y - Sz), Point(X - Sz, Y)]);
      end;
    drDown:
      begin
        Dec(Y, Shift);
        Canvas.Polygon([Point(X + Sz, Y), Point(X, Y + Sz), Point(X - Sz, Y)]);
      end;
    drLeft:
      begin
        Inc(X, Shift);
        Canvas.Polygon([Point(X, Y + Sz), Point(X - Sz, Y), Point(X, Y - Sz)]);
      end;
    drRight:
      begin
        Dec(X, Shift);
        Canvas.Polygon([Point(X, Y + Sz), Point(X + Sz, Y), Point(X, Y - Sz)]);
      end;
  end;
end;

const
  FIRST_DELAY = 600;
  SCROLL_INTERVAL = 100;
  HOTTRACK_INTERVAL = 150;
  MIN_SIZE = 17;

{ TArrowBar }

{$IFDEF CLX}
procedure TArrowBar.EnabledChanged;
{$ELSE}
procedure TArrowBar.CMEnabledChanged(var Message: TMessage);
{$ENDIF}
begin
  inherited;
  Invalidate;
end;

{$IFDEF CLX}
procedure TArrowBar.MouseLeave(AControl: TControl);
{$ELSE}
procedure TArrowBar.CMMouseLeave(var Message: TMessage);
{$ENDIF}
begin
  MouseLeft;
end;

constructor TArrowBar.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csAcceptsControls, csDoubleClicks] + [csOpaque];
  Width := 100;
  Height := 16;
  ParentColor := False;
  Color := clScrollBar;
  Timer := TTimer.Create(Self);
  Timer.OnTimer := TimerHandler;
  FShowArrows := True;
  FBorderStyle := bsSingle;
  FHandleColor := clBtnShadow;
  FButtonColor := clBtnFace;
  FHighLightColor := clBtnHighlight;
  FShadowColor := clBtnShadow;
  FBorderColor := clWindowFrame;
  FShowHandleGrip := True;
end;

procedure TArrowBar.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
  if GenChange and Assigned(FOnUserChange) then FOnUserChange(Self);
end;

procedure TArrowBar.DoDrawButton(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean);
const
  EnabledFlags: array [Boolean] of Integer = (DFCS_INACTIVE, 0);
  PushedFlags: array [Boolean] of Integer = (0, DFCS_PUSHED or DFCS_FLAT);
  DirectionFlags: array [TRBDirection] of Integer = (DFCS_SCROLLLEFT, DFCS_SCROLLUP,
    DFCS_SCROLLRIGHT, DFCS_SCROLLDOWN);
{$IFNDEF CLX}
  DirectionXPFlags: array [TRBDirection] of Cardinal = (ABS_LEFTNORMAL, ABS_UPNORMAL,
    ABS_RIGHTNORMAL, ABS_DOWNNORMAL);
{$ENDIF}
var
  Edges: TRBDirections;
{$IFNDEF CLX}
  Flags: Integer;
{$ENDIF}
begin
  if Style = rbsDefault then
  begin
{$IFDEF CLX}
    Canvas.Brush.Color := clButton;
    Canvas.FillRect(R);
    DrawWinButton(Canvas, R, Pushed);
    InflateRect(R, -2, -2);

    If not DrawEnabled then
    begin
      InflateRect(R, -1, -1);
      OffsetRect(R, 1, 1);
      DrawArrow(Canvas, R, Direction, clWhite);
      OffsetRect(R, -1, -1);
      DrawArrow(Canvas, R, Direction, clDisabledButtonText);
    end
    else
    begin
      If Pushed then OffsetRect(R, 1, 1);
      DrawArrow(Canvas, R, Direction, clButtonText);
    end;
{$ELSE}
    if USE_THEMES then
    begin
      Flags := DirectionXPFlags[Direction];
      if not Enabled then Inc(Flags, 3)
      else if Pushed then Inc(Flags, 2)
      else if Hot then Inc(Flags);
      DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, SBP_ARROWBTN, Flags, R, nil);
    end
    else
      DrawFrameControl(Canvas.Handle, R, DFC_SCROLL,
        DirectionFlags[Direction] or EnabledFlags[DrawEnabled] or PushedFlags[Pushed])
{$ENDIF}
  end
  else
  begin
    Edges := [drLeft, drUp, drRight, drDown];
    Exclude(Edges, OppositeDirection[Direction]);

    if not DrawEnabled then
    begin
      DrawRectEx(Canvas, R, Edges, fShadowColor);
      Canvas.Brush.Color := fButtonColor;
{$IFDEF CLX}
      Canvas.FillRect(R);
{$ELSE}
      FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
{$ENDIF}
      InflateRect(R, -1, -1);
      OffsetRect(R, 1, 1);
      DrawArrow(Canvas, R, Direction, fHighLightColor);
      OffsetRect(R, -1, -1);
      DrawArrow(Canvas, R, Direction, fShadowColor);
    end
    else
    begin
      DrawRectEx(Canvas, R, Edges, fBorderColor);
      if Pushed then
      begin
        Canvas.Brush.Color := fButtonColor;
{$IFDEF CLX}
        Canvas.FillRect(R);
{$ELSE}
        FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
{$ENDIF}
        OffsetRect(R, 1, 1);
        InflateRect(R, -1, -1);
      end
      else
      begin
        Frame3D(Canvas, R, fHighLightColor, fShadowColor, True);
        Canvas.Brush.Color := fButtonColor;
{$IFDEF CLX}
        Canvas.FillRect(R);
{$ELSE}
        FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
{$ENDIF}
      end;
      DrawArrow(Canvas, R, Direction, fBorderColor);
    end;
  end;
end;

procedure TArrowBar.DoDrawHandle(R: TRect; Horz, Pushed, Hot: Boolean);
{$IFNDEF CLX}
const
  PartXPFlags: array [Boolean] of Cardinal = (SBP_THUMBBTNVERT, SBP_THUMBBTNHORZ);
  GripperFlags: array [Boolean] of Cardinal = (SBP_GRIPPERVERT, SBP_GRIPPERHORZ);
var
  Flags: Cardinal;
{$ENDIF}
begin
  if IsRectEmpty(R) then Exit;
  case Style of
    rbsDefault:
{$IFNDEF CLX}
      if USE_THEMES then
      begin
        Flags := SCRBS_NORMAL;
        if not Enabled then Inc(Flags, 3)
        else if Pushed then Inc(Flags, 2)
        else if Hot then Inc(Flags);
        DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, PartXPFlags[Horz], Flags, R, nil);
        if ShowHandleGrip then
          DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, GripperFlags[Horz], 0, R, nil);
      end
      else
        DrawEdge(Canvas.Handle, R, EDGE_RAISED, BF_RECT or BF_MIDDLE);
{$ELSE}
      begin
        Canvas.Brush.Color := clButton;
        Canvas.FillRect(R);
        DrawWinButton(Canvas, R, False);
      end;
{$ENDIF}
    rbsMac:
      DrawHandle(Canvas, R, HandleColor, Pushed, ShowHandleGrip, Horz, fBorderColor);
  end;
end;

procedure TArrowBar.DoDrawTrack(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean);
{$IFNDEF CLX}
const
  PartXPFlags: array [TRBDirection] of Cardinal =
    (SBP_LOWERTRACKHORZ, SBP_LOWERTRACKVERT, SBP_UPPERTRACKHORZ, SBP_UPPERTRACKVERT);
{$ENDIF}
var
{$IFNDEF CLX}
  Flags: Cardinal;
{$ENDIF}
  C: TColor;
  Edges: set of TRBDirection;
begin
  if (R.Right <= R.Left) or (R.Bottom <= R.Top) then Exit;
  if Style = rbsDefault then
  begin
{$IFNDEF CLX}
    if USE_THEMES then
    begin
      Flags := SCRBS_NORMAL;
      if Pushed then Inc(Flags, 2);
      DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, PartXPFlags[Direction], Flags, R, nil);
    end
    else
{$ENDIF}
    begin
      if Pushed then DitherRect(Canvas, R, clWindowFrame, clWindowFrame)
      else DitherRect(Canvas, R, clBtnHighlight, Color);
    end;
  end
  else
  with Canvas, R do
  begin
    if DrawEnabled then C := FBorderColor
    else C := FShadowColor;
    Edges := [drLeft, drUp, drRight, drDown];
    Exclude(Edges, OppositeDirection[Direction]);
    DrawRectEx(Canvas, R, Edges, C);
    if Pushed then DitherRect(Canvas, R, fBorderColor,fBorderColor)
    else if not IsRectEmpty(R) then with R do
    begin
      if DrawEnabled then
      begin
        Pen.Color := MixColors(fBorderColor, MixColors(fHighLightColor, Color, 127), 32);
        case Direction of
          drLeft, drUp:
            begin
              MoveTo(Left, Bottom - 1); LineTo(Left, Top); LineTo(Right, Top);
              Inc(Top); Inc(Left);
            end;
          drRight:
            begin
              MoveTo(Left, Top); LineTo(Right, Top);
              Inc(Top);
            end;
          drDown:
            begin
              MoveTo(Left, Top); LineTo(Left, Bottom);
              Inc(Left);
            end;
        end;
        if Backgnd = bgPattern then DitherRect(Canvas, R, fHighLightColor, Color)
        else DitherRect(Canvas, R, Color, Color);
      end
      else
      begin
        Brush.Color := fButtonColor;
        FillRect(R);
      end;
    end;
  end;
end;

function TArrowBar.DrawEnabled: Boolean;
begin
  Result := Enabled;
end;

{$IFNDEF CLX}
procedure TArrowBar.DrawNCArea(ADC: HDC; const Clip: HRGN);
var
  DC: HDC;
  R: TRect;
begin
  if BorderStyle = bsNone then Exit;
  if ADC = 0 then DC := GetWindowDC(Handle)
  else DC := ADC;
  try
    GetWindowRect(Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
  finally
    if ADC = 0 then ReleaseDC(Handle, DC);
  end;
end;
{$ENDIF}

function TArrowBar.GetBorderSize: Integer;
const
  CSize: array [Boolean] of Integer = (0, 1);
begin
  Result := CSize[BorderStyle = bsSingle];
end;

function TArrowBar.GetButtonSize: Integer;
var
  W, H: Integer;
begin
  if not ShowArrows then Result := 0
  else
  begin
    Result := ButtonSize;
    if Kind = sbHorizontal then
    begin
      W := ClientWidth;
      H := ClientHeight;
    end
    else
    begin
      W := ClientHeight;
      H := ClientWidth;
    end;
    if Result = 0 then Result := Min(H, 32);
    if Result * 2 >= W then Result := W div 2;
    if Style = rbsMac then Dec(Result);
    if Result < 2 then Result := 0;
  end;
end;

function TArrowBar.GetHandleRect: TRect;
begin
  Result := Rect(0, 0, 0, 0);
end;

function TArrowBar.GetTrackBoundary: TRect;
begin
  Result := ClientRect;
  if Kind = sbHorizontal then InflateRect(Result, -GetButtonSize, 0)
  else InflateRect(Result, 0, -GetButtonSize);
end;

function TArrowBar.GetZone(X, Y: Integer): TRBZone;
var
  P: TPoint;
  R, R1: TRect;
  Sz: Integer;
begin
  Result := zNone;

  P := Point(X, Y);
  R := ClientRect;
  if not PtInrect(R, P) then Exit;

  Sz := GetButtonSize;
  R1 := R;
  if Kind = sbHorizontal then
  begin
    R1.Right := R1.Left + Sz;