grid icindeki scroll bar

[Hakkan]

grid kontrolundeki kaydirma cubuklari cok kucuk.
grid`in icindeki verilere gore kaydirma cubuklarini genisletmek istiyorum.
Or: Az sayfa varken genis cubuklar, cok sayfa varken dar...

Ilginize tesekkur ederim.

h.k

[Hakkan]

grid kontrolundeki kaydirma cubuklari cok kucuk.
grid`in icindeki verilere gore kaydirma cubuklarini genisletmek istiyorum.
Or: Az sayfa varken genis cubuklar, cok sayfa varken dar...

Ilginize tesekkur ederim.

h.k

Bu yaraya merhem olan yok galiba

h.k

[ScRiPTeR]

merhaba,
ne kadar fazla kayit olursa kaydirma cubuklari o derece kuculur.
iyi calismalar.

[husonet]

Aslında bu istediğiniz yapılabilir Ama olayın Object Kısmına inmek lazım.
Delphi'ni hiterarşisini incelemenizi tafsiye ederim.

Kolay Gelsin...

[Hakkan]

Aslında bu istediğiniz yapılabilir Ama olayın Object Kısmına inmek lazım.
Delphi'ni hiterarşisini incelemenizi tafsiye ederim.

Kolay Gelsin...

Grid icindeki alt bilesenlerden halledebilirim diye dusunmustum fakat hic alt bilesen yok. Yani Grid icindeki ScrollBar nesnesine erisemedim.
SPY++ programiyla baktigimda da Grid kontrolu tek pencere olarak gozukuyor.

Kaydirma cubuklarini kendim koyarak da cozebilirim ama biraz kolayina kacmak daha guzel olurdu.


Ilginize tesekkur ederim...

h.k

[husonet]

TScrollBar bileşenini inceleyin

Kolay Gelsin...

[husonet]

Kod: Tümünü seç

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TStateStyleProperty = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FColorCold, FColorHot, FColorDown: TColor;
    FStyleCold, FStyleHot, FStyleDown: TBrushStyle;
    FPatternCold, FPatternHot, FPatternDown: TBitmap;
  protected
    procedure SetColorCold(const Value: TColor);
    procedure SetColorHot(const Value: TColor);
    procedure SetColorDown(const Value: TColor);
    procedure SetStyleCold(const Value: TBrushStyle);
    procedure SetStyleHot(const Value: TBrushStyle);
    procedure SetStyleDown(const Value: TBrushStyle);
    procedure SetPatternCold(const Value: TBitmap);
    procedure SetPatternHot(const Value: TBitmap);
    procedure SetPatternDown(const Value: TBitmap);
  public
    procedure Changed;
    constructor Create;
    destructor Destroy; override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property ColorCold: TColor read FColorCold write SetColorCold;
    property ColorHot: TColor read FColorHot write SetColorHot;
    property ColorDown: TColor read FColorDown write SetColorDown;
    property StyleCold: TBrushStyle read FStyleCold write SetStyleCold;
    property StyleHot: TBrushStyle read FStyleHot write SetStyleHot;
    property StyleDown: TBrushStyle read FStyleDown write SetStyleDown;
    property PatternCold: TBitmap read FPatternCold write SetPatternCold;
    property PatternHot: TBitmap read FPatternHot write SetPatternHot;
    property PatternDown: TBitmap read FPatternDown write SetPatternDown;
  end;

  TStyleProperty = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FOwner: TObject;
    FBorder, FFill: TStateStyleProperty;
  protected
    procedure Changed;
    procedure StyleChanged(Sender: TObject);
  public
    constructor Create(AOwner: TObject);
    destructor Destroy; override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Border: TStateStyleProperty read FBorder write FBorder;
    property Fill: TStateStyleProperty read FFill write FFill;
  end;

  TScrollbarArea = (saArrowDown, saArrowUp, saTrackDown, saTrackUp, saScroller, saNone);
  TAreaRects = array[TScrollbarArea] of TRect;
  TAreaState = (asCold, asHot, asDown);
  TAreaStates = array[TScrollbarArea] of TAreaState;
  TArrowPoly = array[0..2] of TPoint;

  TMouseState = record
    Pos: TPoint;
    Button: TMouseButton;
    Shift: TShiftState;
  end;

  TFatScrollBar = class(TGraphicControl)
  private
    { Private declarations }
    FArrowWidth, FScrollerWidth, FMax, FMin, FArrowStretch,
    FLargeChange, FSmallChange, FPosition: Integer;
    FKind: TScrollBarKind;
    FOnChange, FOnMouseIn, FOnMouseOut: TNotifyEvent;
    FStyleArrow, FStyleArrowButton, FStyleScroller, FStyleTrack: TStyleProperty;
    FArrowPoly: array[saArrowDown..saArrowUp] of TArrowPoly;
    FAreaRect: TAreaRects;
    FAreaState: TAreaStates;
    DownAt: TScrollbarArea;
    Scrolling: Boolean;
    ScrollPos, ScrollOffset: TPoint;
    FScrollTimer: TTimer;
    FScrollArea: TScrollbarArea;
    FMouseState: TMouseState;
    FBuffer: TBitmap;
  protected
    { Protected declarations }
    function GetInterval: Integer;
    procedure SetInterval(const Value: Integer);
    procedure SetKind(const Value: TScrollBarKind);
    procedure SetScrollerWidth(const Value: Integer);
    procedure SetArrowWidth(const Value: Integer);
    procedure SetArrowStretch(const Value: Integer);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetLargeChange(const Value: Integer);
    procedure SetSmallChange(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure GetStyleByState(const State: TAreaState; StyleProperty: TStyleProperty;
      var CBorder, CFill: TColor; var SBorder, SFill: TBrushStyle; var BBorder, BFill: TBitmap);
    procedure PaintArea(const Area: TScrollbarArea);
    function CheckArrowWidth(const AWidth: Integer): Integer;
    function CheckScrollerWidth(const AWidth: Integer): Integer;

    procedure ScrollerChanged;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;

    procedure StyleArrowChanged(Sender: TObject);
    procedure StyleArrowButtonChanged(Sender: TObject);
    procedure StyleScrollerChanged(Sender: TObject);
    procedure StyleTrackChanged(Sender: TObject);

    procedure AreaClick(const Area: TScrollbarArea);
    procedure AreaMouseDown(const Area: TScrollbarArea);
    procedure AreaMouseUp(const Area: TScrollbarArea);
    procedure ScrollToPos(const X, Y: Integer);

    procedure GetScrollerInfo(var X, Y, W, H: Integer);
    procedure RecalculateArrows;
    procedure RecalculateAreas;
    procedure RecalculateScroller;
    procedure DoScrollTimer(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
    procedure WMSize(var M: TMessage); message WM_SIZE;
  published
    { Published declarations }
    property Kind: TScrollBarKind read FKind write SetKind;
    property Align;
    property Anchors;
    property ArrowWidth: Integer read FArrowWidth write SetArrowWidth;
    property ArrowStretch: Integer read FArrowStretch write SetArrowStretch;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property LargeChange: Integer read FLargeChange write SetLargeChange;
    property Max: Integer read FMax write SetMax;
    property Min: Integer read FMin write SetMin;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property Position: Integer read FPosition write SetPosition;
    property ShowHint;
    property SmallChange: Integer read FSmallChange write SetSmallChange;
    property Visible;

    property ScrollInterval: Integer read GetInterval write SetInterval;
    property StyleArrow: TStyleProperty read FStyleArrow write FStyleArrow;
    property StyleArrowButton: TStyleProperty read FStyleArrowButton write FStyleArrowButton;
    property StyleScroller: TStyleProperty read FStyleScroller write FStyleScroller;
    property StyleTrack: TStyleProperty read FStyleTrack write FStyleTrack;
    property ScrollerWidth: Integer read FScrollerWidth write SetScrollerWidth;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnStartDock;
    property OnStartDrag;

    property OnMouseIn: TNotifyEvent read FOnMouseIn write FOnMouseIn;
    property OnMouseOut: TNotifyEvent read FOnMouseOut write FOnMouseOut;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;
var
  Form1: TForm1;

implementation
const
  AreaOrder: array[0..4] of TScrollbarArea =
    (saArrowDown, saArrowUp, saTrackDown, saTrackUp, saScroller);
{$R *.dfm}
function PercentValue(const Value, Percent: Integer): Integer;
begin
  Result := Round(Value / 100 * Percent);
end;

constructor TStateStyleProperty.Create;
begin
  inherited;
  FPatternCold := TBitmap.Create;
  FPatternHot := TBitmap.Create;
  FPatternDown := TBitmap.Create;
end;

destructor TStateStyleProperty.Destroy;
begin
  FPatternCold.Free;
  FPatternHot.Free;
  FPatternDown.Free;
  inherited;
end;

procedure TStateStyleProperty.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TStateStyleProperty.SetColorCold(const Value: TColor);
begin
  if Value <> FColorCold then begin
    FColorCold := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetColorHot(const Value: TColor);
begin
  if Value <> FColorHot then begin
    FColorHot := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetColorDown(const Value: TColor);
begin
  if Value <> FColorDown then begin
    FColorDown := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetStyleCold(const Value: TBrushStyle);
begin
  if Value <> FStyleCold then begin
    FStyleCold := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetStyleHot(const Value: TBrushStyle);
begin
  if Value <> FStyleHot then begin
    FStyleHot := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetStyleDown(const Value: TBrushStyle);
begin
  if Value <> FStyleDown then begin
    FStyleDown := Value;
    Changed;
  end;
end;

procedure TStateStyleProperty.SetPatternCold(const Value: TBitmap);
begin
  FPatternCold.Assign(Value);
  Changed;
end;

procedure TStateStyleProperty.SetPatternHot(const Value: TBitmap);
begin
  FPatternHot.Assign(Value);
  Changed;
end;

procedure TStateStyleProperty.SetPatternDown(const Value: TBitmap);
begin
  FPatternDown.Assign(Value);
  Changed;
end;






constructor TStyleProperty.Create(AOwner: TObject);
begin
  inherited Create;
  FOwner := AOwner;
  FBorder := TStateStyleProperty.Create;
  FBorder.OnChange := StyleChanged;
  FFill := TStateStyleProperty.Create;
  FFill.OnChange := StyleChanged;
end;

destructor TStyleProperty.Destroy;
begin
  FBorder.Free;
  FFill.Free;
  inherited;
end;

procedure TStyleProperty.StyleChanged(Sender: TObject);
begin
  Changed;
end;

procedure TStyleProperty.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;





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

  FBuffer := TBitmap.Create;
  FLargeChange := 5;
  FSmallChange := 1;
  FMin := 0;
  FMax := 100;
  FPosition := 0;

  FScrollTimer := TTimer.Create(Self);
  with FScrollTimer do begin
    Enabled := False;
    Interval := 50;
    OnTimer := DoScrollTimer;
  end;

  FStyleArrow := TStyleProperty.Create(Self);
  with FStyleArrow do begin
    OnChange := StyleArrowChanged;
    Border.ColorCold := clWindowText;
    Fill.ColorCold := clWindowText;

    Border.ColorHot := clWindow;
    Fill.ColorHot := clWindow;

    Border.ColorDown := clWindow;
    Fill.ColorDown := clWindow;
  end;

  FStyleArrowButton := TStyleProperty.Create(Self);
  with FStyleArrowButton do begin
    OnChange := StyleArrowButtonChanged;
    Border.ColorCold := clBtnShadow;
    Fill.ColorCold := clBtnFace;

    Border.ColorHot := clBtnShadow;
    Fill.ColorHot := clBtnShadow;

    Border.ColorDown := clWindow;
    Fill.ColorDown := clWindowText;
  end;

  FStyleTrack := TStyleProperty.Create(Self);
  with FStyleTrack do begin
    OnChange := StyleTrackChanged;
    Border.ColorCold := clBtnShadow;
    Fill.ColorCold := clWindow;

    Border.ColorHot := clBtnShadow;
    Fill.ColorHot := clBtnShadow;

    Border.ColorDown := clWindow;
    Fill.ColorDown := clWindowText;
  end;

  FStyleScroller := TStyleProperty.Create(Self);
  with FStyleScroller do begin
    OnChange := StyleScrollerChanged;
    Border.ColorCold := clBtnShadow;
    Fill.ColorCold := clBtnFace;

    Border.ColorHot := clBtnShadow;
    Fill.ColorHot := clBtnShadow;

    Border.ColorDown := clWindow;
    Fill.ColorDown := clWindowText;
  end;

  Width := 150;
  ArrowWidth := 18;
  ArrowStretch := 35;
  Height := FArrowWidth;
  FScrollerWidth := ArrowWidth;
  DownAt := saNone;
end;

destructor TFatScrollBar.Destroy;
begin
  FScrollTimer.Free;
  FStyleArrow.Free;
  FStyleArrowButton.Free;
  FStyleTrack.Free;
  FStyleScroller.Free;
  FBuffer.Free;
  inherited;
end;

procedure TFatScrollBar.StyleArrowChanged(Sender: TObject);
begin
  Repaint;
  //PaintArea(saArrowDown);
  //PaintArea(saArrowUp);
end;

procedure TFatScrollBar.StyleArrowButtonChanged(Sender: TObject);
begin
  Repaint;
  //PaintArea(saArrowDown);
  //PaintArea(saArrowUp);
end;

procedure TFatScrollBar.StyleTrackChanged(Sender: TObject);
begin
  Repaint;
  //PaintArea(saTrackDown);
  //PaintArea(saTrackUp);
end;

procedure TFatScrollBar.StyleScrollerChanged(Sender: TObject);
begin
  Repaint;
  //PaintArea(saScroller);
end;

procedure TFatScrollBar.ScrollerChanged;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TFatScrollBar.GetInterval: Integer;
begin
  Result := FScrollTimer.Interval;
end;

procedure TFatScrollBar.SetInterval(const Value: Integer);
begin
  if (Value > 0) and (Value < 10000) then
    FScrollTimer.Interval := Value;
end;

procedure TFatScrollBar.SetKind(const Value: TScrollBarKind);
begin
  if FKind <> Value then begin
    FKind := Value;
    RecalculateAreas;
    Repaint;
  end;
end;

function TFatScrollBar.CheckScrollerWidth(const AWidth: Integer): Integer;
var AMin, AMax: Integer;
begin
  AMin := 2;
  case FKind of
    sbHorizontal : AMax := Width - FArrowWidth * 2 - 1;
    sbVertical   : AMax := Height - FArrowWidth * 2 - 1;
    else begin
      Result := AMin;
      Exit;
    end;
  end;

  if AWidth < AMin then
    Result := AMin else
  if AWidth > AMax then
    Result := AMax else
    Result := AWidth;
end;

function TFatScrollBar.CheckArrowWidth(const AWidth: Integer): Integer;
var AMin, AMax: Integer;
begin
  AMin := 2;
  case FKind of
    sbHorizontal : AMax := Width div 2;
    sbVertical   : AMax := Height div 2;
    else begin
      Result := AMin;
      Exit;
    end;
  end;

  if AWidth < AMin then
    Result := AMin else
  if AWidth > AMax then
    Result := AMax else
    Result := AWidth;
end;

procedure TFatScrollBar.SetArrowStretch(const Value: Integer);
begin
  if Value <> FArrowStretch then begin
    if Value <= 0 then
      FArrowStretch := 1 else
    if Value > 100 then
      FArrowStretch := 100 else
      FArrowStretch := Value;

    RecalculateAreas;
    Repaint;
  end;
end;

procedure TFatScrollBar.SetScrollerWidth(const Value: Integer);
var NewWidth: Integer;
begin
  NewWidth := CheckScrollerWidth(Value);
  if NewWidth <> FScrollerWidth then begin
    FScrollerWidth := NewWidth;
    RecalculateScroller;
    Repaint;
  end;
end;

procedure TFatScrollBar.SetArrowWidth(const Value: Integer);
var NewWidth: Integer;
begin
  NewWidth := CheckArrowWidth(Value);
  if NewWidth <> FArrowWidth then begin
    FArrowWidth := NewWidth;
    RecalculateAreas;
    Repaint;
  end;
end;

procedure TFatScrollBar.SetMax(const Value: Integer);
begin
  if (Value <> FMax) and (Value >= 0) and (Value >= FMin) then begin
    FMax := Value;
    RecalculateScroller;
    Repaint;
  end;
end;

procedure TFatScrollBar.SetMin(const Value: Integer);
begin
  if (Value <> FMin) and (Value >= 0) and (Value <= FMax)  then begin
    FMin := Value;
    RecalculateScroller;
    Repaint;
  end;
end;

procedure TFatScrollBar.SetLargeChange(const Value: Integer);
begin
  if (Value <> FLargeChange) and (Value >= FSmallChange) and (Value > 0) then begin
    FLargeChange := Value;
  end;
end;

procedure TFatScrollBar.SetSmallChange(const Value: Integer);
begin
  if (Value <> FSmallChange) and (Value > 0) and (Value < FLargeChange) then begin
    FSmallChange := Value;
  end;
end;

procedure TFatScrollBar.SetPosition(const Value: Integer);
begin
  if (Value <> FPosition) and (Value >= FMin) and (Value <= FMax) then begin
    FPosition := Value;
    RecalculateScroller;
    PaintArea(saTrackDown);
    PaintArea(saScroller);
    PaintArea(saTrackUp);
    ScrollerChanged;
  end;
end;

procedure TFatScrollBar.GetScrollerInfo(var X, Y, W, H: Integer);
var AWidth: Integer;
  Percent: Double;
begin
  case FKind of
    sbHorizontal: begin
      AWidth := FAreaRect[saArrowUp].Left - FAreaRect[saArrowDown].Right - FScrollerWidth;
      W := FScrollerWidth;
      H := Height;

      Percent := FPosition / FMax * 100;
      X := FAreaRect[saArrowDown].Right + Round(Percent * AWidth / 100);
      Y := 0;
    end;
    sbVertical: begin
      AWidth := FAreaRect[saArrowUp].Top - FAreaRect[saArrowDown].Bottom - FScrollerWidth;
      W := Width;
      H := FScrollerWidth;

      Percent := FPosition / FMax * 100;
      Y := FAreaRect[saArrowDown].Bottom + Round(Percent * AWidth / 100);
      X := 0;
    end;
  end;
end;

procedure TFatScrollBar.RecalculateScroller;
var X, Y, W, H: Integer;
begin
  GetScrollerInfo(X, Y, W, H);
  FAreaRect[saScroller] := Bounds(X, Y, W, H);

  case FKind of
    sbHorizontal: begin
      FAreaRect[saTrackDown] := Rect(FAreaRect[saArrowDown].Right, 0,
        FAreaRect[saScroller].Left, Height);
      FAreaRect[saTrackUp] := Rect(FAreaRect[saScroller].Right, 0,
        FAreaRect[saArrowUp].Left, Height);
    end;

    sbVertical: begin
      FAreaRect[saTrackDown] := Rect(0, FAreaRect[saArrowDown].Bottom,
        Width, FAreaRect[saScroller].Top);
      FAreaRect[saTrackUp] := Rect(0, FAreaRect[saScroller].Bottom,
        Width, FAreaRect[saArrowUp].Top);
    end;
  end;
end;

procedure TFatScrollBar.RecalculateArrows;
var I: Integer;
  P: TArrowPoly;
begin
  case FKind of
    sbHorizontal: begin
      FAreaRect[saArrowDown] := Bounds(0, 0, FArrowWidth, Height);
      P[0] := Point(PercentValue(FArrowWidth, FArrowStretch), PercentValue(Height, 50));
      P[1] := Point(PercentValue(FArrowWidth, 100 - FArrowStretch), PercentValue(Height, FArrowStretch));
      P[2] := Point(PercentValue(FArrowWidth, 100 - FArrowStretch), PercentValue(Height, 100 - FArrowStretch));
      FArrowPoly[saArrowDown] := P;

      FAreaRect[saArrowUp] := Bounds(Width - FArrowWidth, 0, FArrowWidth, Height);
      P[0] := Point(PercentValue(FArrowWidth, 100 - FArrowStretch), PercentValue(Height, 50));
      P[1] := Point(PercentValue(FArrowWidth, FArrowStretch), PercentValue(Height, FArrowStretch));
      P[2] := Point(PercentValue(FArrowWidth, FArrowStretch), PercentValue(Height, 100 - FArrowStretch));
      FArrowPoly[saArrowUp] := P;
      for I := 0 to 2 do
        FArrowPoly[saArrowUp][I].x := P[I].x + FAreaRect[saArrowUp].Left;
    end;

    sbVertical: begin
      FAreaRect[saArrowDown] := Bounds(0, 0, Width, FArrowWidth);
      P[0] := Point(PercentValue(Width, 50), PercentValue(FArrowWidth, FArrowStretch));
      P[1] := Point(PercentValue(Width, FArrowStretch), PercentValue(FArrowWidth, 100 - FArrowStretch));
      P[2] := Point(PercentValue(Width, 100 - FArrowStretch), PercentValue(FArrowWidth, 100 - FArrowStretch));
      FArrowPoly[saArrowDown] := P;

      FAreaRect[saArrowUp] := Bounds(0, Height - FArrowWidth, Width, FArrowWidth);
      P[0] := Point(PercentValue(Width, 50), PercentValue(FArrowWidth, 100 - FArrowStretch));
      P[1] := Point(PercentValue(Width, FArrowStretch), PercentValue(FArrowWidth, FArrowStretch));
      P[2] := Point(PercentValue(Width, 100 - FArrowStretch), PercentValue(FArrowWidth, FArrowStretch));
      FArrowPoly[saArrowUp] := P;
      for I := 0 to 2 do
        FArrowPoly[saArrowUp][I].y := P[I].y + FAreaRect[saArrowUp].Top;
    end;
  end;
end;

procedure TFatScrollBar.RecalculateAreas;
begin
  RecalculateArrows;
  RecalculateScroller;
end;

procedure TFatScrollBar.Paint;
var Area: TScrollbarArea;
begin
  for Area := saArrowDown to saScroller do
    PaintArea(Area);
end;

procedure TFatScrollBar.GetStyleByState(const State: TAreaState; StyleProperty: TStyleProperty;
      var CBorder, CFill: TColor; var SBorder, SFill: TBrushStyle; var BBorder, BFill: TBitmap);
begin
  case State of
    asCold: begin
      CBorder := StyleProperty.Border.ColorCold;
      CFill := StyleProperty.Fill.ColorCold;
      SBorder := StyleProperty.Border.StyleCold;
      SFill := StyleProperty.Fill.StyleCold;
      BBorder := StyleProperty.Border.PatternCold;
      BFill := StyleProperty.Fill.PatternCold;
    end;
    asHot: begin
      CBorder := StyleProperty.Border.ColorHot;
      CFill := StyleProperty.Fill.ColorHot;
      SBorder := StyleProperty.Border.StyleHot;
      SFill := StyleProperty.Fill.StyleHot;
      BBorder := StyleProperty.Border.PatternHot;
      BFill := StyleProperty.Fill.PatternHot;
    end;
    asDown: begin
      CBorder := StyleProperty.Border.ColorDown;
      CFill := StyleProperty.Fill.ColorDown;
      SBorder := StyleProperty.Border.StyleDown;
      SFill := StyleProperty.Fill.StyleDown;
      BBorder := StyleProperty.Border.PatternDown;
      BFill := StyleProperty.Fill.PatternDown;
    end;
  end;
end;

procedure TFatScrollBar.PaintArea(const Area: TScrollbarArea);
var AreaRect: TRect;
  Poly: TArrowPoly;
  AreaStyle, PolyStyle: TStyleProperty;
  ColorBorder, ColorFill: TColor;
  StyleBorder, StyleFill: TBrushStyle;
  PatternBorder, PatternFill: TBitmap;
begin
  AreaRect := FAreaRect[Area];
  case Area of
    saArrowDown, saArrowUp : begin
      AreaStyle := FStyleArrowButton;
      PolyStyle := FStyleArrow;
      Poly := FArrowPoly[Area];
    end;
    saTrackDown, saTrackUp : begin
      AreaStyle := FStyleTrack;
      PolyStyle := NIL;
    end;
    saScroller : begin
      AreaStyle := FStyleScroller;
      PolyStyle := NIL;
    end;
    else Exit;
  end;

  with FBuffer.Canvas do begin
    GetStyleByState(FAreaState[Area], AreaStyle,
      ColorBorder, ColorFill, StyleBorder, StyleFill,
      PatternBorder, PatternFill);

    if PatternFill.Empty then begin
      Brush.Color := ColorFill;
      Brush.Style := StyleFill;
    end else
      Brush.Bitmap := PatternFill;
    FillRect(AreaRect);

    if PatternBorder.Empty then begin
      Brush.Color := ColorBorder;
      Brush.Style := StyleBorder;
    end else
      Brush.Bitmap := PatternBorder;
    FrameRect(AreaRect);
  end;

  if PolyStyle <> NIL then
    with FBuffer.Canvas do begin
      GetStyleByState(FAreaState[Area], PolyStyle,
        ColorBorder, ColorFill, StyleBorder, StyleFill,
        PatternBorder, PatternFill);

      if PatternFill.Empty then begin
        Brush.Color := ColorFill;
        Brush.Style := StyleFill;
      end else
        Brush.Bitmap := PatternFill;

      Pen.Color := ColorBorder;
      Polygon(Poly);
    end;

  //Canvas.Draw(0, 0, FBuffer);
  Canvas.CopyRect(AreaRect, FBuffer.Canvas, AreaRect);
end;

procedure TFatScrollBar.CMMouseEnter(var M: TMessage);
begin
  if Assigned(FOnMouseIn) then
    FOnMouseIn(Self);
end;

procedure TFatScrollBar.WMSize(var M: TMessage);
begin
  inherited;
  Resize;
end;

procedure TFatScrollBar.CMMouseLeave(var M: TMessage);
begin
  MouseMove([], -1, -1);
  if Assigned(FOnMouseOut) then
    FOnMouseOut(Self);
end;




procedure TFatScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var I: Integer;
  NewState: TAreaState;
  Area: TScrollbarArea;
begin
  inherited;

  FMouseState.Button := Button;
  FMouseState.Shift := Shift;
  FMouseState.Pos := Point(X, Y);
  for I := 0 to 4 do begin
    Area := AreaOrder[I];

    if PtInRect(FAreaRect[Area], FMouseState.Pos) then begin
      if ssLeft in Shift then begin
        NewState := asDown;
        DownAt := Area;
        AreaMouseDown(Area);
      end else
        NewState := asHot;

      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end else
    begin
      NewState := asCold;
      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end;
  end;
end;

procedure TFatScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var I: Integer;
  NewState: TAreaState;
  Area: TScrollbarArea;
begin
  inherited;

  FMouseState.Button := Button;
  FMouseState.Shift := Shift;
  FMouseState.Pos := Point(X, Y);

  if Button = mbLeft then
    FScrollTimer.Enabled := False;
  
  for I := 0 to 4 do begin
    Area := AreaOrder[I];
    if PtInRect(FAreaRect[Area], FMouseState.Pos) then begin
      if DownAt = Area then begin
        AreaMouseUp(Area);
        NewState := asHot;
        DownAt := saNone;
      end else
        NewState := asHot;

      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end else
    begin
      NewState := asCold;
      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end;
  end;
end;

procedure TFatScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var I: Integer;
  NewState: TAreaState;
  Area: TScrollbarArea;
begin
  inherited;

  FMouseState.Shift := Shift;
  FMouseState.Pos := Point(X, Y);

  if (ssLeft in Shift) and (DownAt = saScroller) then begin
    ScrollToPos(X, Y);
    Exit;
  end;

  for I := 0 to 4 do begin
    Area := AreaOrder[I];

    if PtInRect(FAreaRect[Area], FMouseState.Pos) then begin
      if (ssLeft in Shift) and (DownAt = Area) then begin
        NewState := asDown;
        AreaMouseDown(Area);
      end else
        NewState := asHot;

      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end else
    begin
      NewState := asCold;
      if FAreaState[Area] <> NewState then begin
        FAreaState[Area] := NewState;
        PaintArea(Area);
      end;
    end;
  end;
end;


procedure TFatScrollBar.Resize;
begin
  FBuffer.Width := Width;
  FBuffer.Height := Height;
  RecalculateAreas;
  inherited;
end;

procedure TFatScrollBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  Resize;
end;

procedure TFatScrollBar.DoScrollTimer(Sender: TObject);
var P: Integer;
begin
  if NOT PtInRect(FAreaRect[FScrollArea], FMouseState.Pos) or (FScrollArea <> DownAt) then begin
    FScrollTimer.Enabled := False;
    with FMouseState do
      MouseMove(Shift, Pos.x, Pos.y);
    Exit;
  end;

  if FScrollArea = saArrowDown then begin
    P := Position - SmallChange;
    if P < Min then
      P := Min;
    Position := P;
  end else
  if FScrollArea = saArrowUp then begin
    P := Position + SmallChange;
    if P > Max then
      P := Max;
    Position := P;
  end else
  if FScrollArea = saTrackDown then begin
    P := Position - LargeChange;
    if P < Min then
      P := Min;
    Position := P;
  end else
  if FScrollArea = saTrackUp then begin
    P := Position + LargeChange;
    if P > Max then
      P := Max;
    Position := P;
  end;
end;

procedure TFatScrollBar.AreaMouseDown(const Area: TScrollbarArea);
begin
  if Area = saScroller then begin
    Scrolling := True;
    ScrollPos := FMouseState.Pos;
    ScrollOffset := Point(ScrollPos.x - FAreaRect[saScroller].Left,
      ScrollPos.y - FAreaRect[saScroller].Top);
  end else
  begin
    FScrollArea := Area;
    FScrollTimer.Enabled := True;
  end;
end;

procedure TFatScrollBar.AreaMouseUp(const Area: TScrollbarArea);
begin
  Scrolling := False;
  FScrollTimer.Enabled := False;
end;

procedure TFatScrollBar.AreaClick(const Area: TScrollbarArea);
begin
end;

procedure TFatScrollBar.ScrollToPos(const X, Y: Integer);
var AWidth, NewPos, ToPos: Integer;
  Percent: Double;
begin
  if Kind = sbHorizontal then begin
    AWidth := Width - 2 * FArrowWidth - FScrollerWidth;
    ToPos := X - FArrowWidth - ScrollOffset.x;
    Percent := ToPos / AWidth * 100;
  end else
  if Kind = sbVertical then begin
    AWidth := Height - 2 * FArrowWidth - FScrollerWidth;
    ToPos := Y - FArrowWidth - ScrollOffset.y;
    Percent := ToPos / AWidth * 100;
  end else
  Exit;

  NewPos := Round(Percent * Max / 100);
  Position := NewPos;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    Deneme : TFatScrollBar;
begin
    Deneme := TFatScrollBar.Create(Self);
    Deneme.Parent := Form1;
end;

Net te biraz sörf yaparken ufak bir bileşen buldum nasıl yapıldığı ortada incelersen olayı çözebilirsin.

Kolay Gelsin...