home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_RangeBars.pas < prev    next >
Pascal/Delphi Source File  |  2005-02-24  |  52KB  |  1,922 lines
  1. unit GR32_RangeBars;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  * Andre Beckedorf <Andre@metaException.de>
  26.  * Marc Lafon
  27.  *
  28.  * ***** END LICENSE BLOCK ***** *)
  29.  
  30. interface
  31.  
  32. {$I GR32.inc}
  33.  
  34. uses
  35. {$IFDEF CLX}
  36.   Qt, Types,
  37.   {$IFDEF LINUX}Libc,{$ENDIF}
  38.   {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  39.   QGraphics, QControls, QForms, QDialogs, QExtCtrls,
  40. {$ELSE}
  41.   Windows, Messages, GR32, {$IFDEF INLININGSUPPORTED}Types,{$ENDIF}
  42.   Graphics, Controls, Forms, Dialogs, ExtCtrls,
  43. {$ENDIF}
  44.   SysUtils, Classes;
  45.  
  46. {$IFDEF CLX}
  47. const
  48.   DFCS_INACTIVE = $100;
  49.   DFCS_PUSHED = $200;
  50.   DFCS_FLAT = $4000;
  51.   DFCS_SCROLLUP = 0;
  52.   DFCS_SCROLLDOWN = 1;
  53.   DFCS_SCROLLLEFT = 2;
  54.   DFCS_SCROLLRIGHT = 3;
  55. {$ENDIF}
  56.  
  57. type
  58.   TRBDirection = (drLeft, drUp, drRight, drDown);
  59.   TRBDirections = set of TRBDirection;
  60.   TRBZone = (zNone, zBtnPrev, zTrackPrev, zHandle, zTrackNext, zBtnNext);
  61.   TRBStyle = (rbsDefault, rbsMac);
  62.   TRBBackgnd = (bgPattern, bgSolid);
  63.   TRBGetSizeEvent = procedure(Sender: TObject; var Size: Integer) of object;
  64.  
  65.   TArrowBar = class(TCustomControl)
  66.   private
  67.     FBackgnd: TRBBackgnd;
  68.     FBorderStyle: TBorderStyle;
  69.     FButtonSize: Integer;
  70.     FHandleColor: TColor;
  71.     FButtoncolor:TColor;
  72.     FHighLightColor:TColor;
  73.     FShadowColor:TColor;
  74.     FBorderColor:TColor;
  75.     FKind: TScrollBarKind;
  76.     FShowArrows: Boolean;
  77.     FShowHandleGrip: Boolean;
  78.     FStyle: TRBStyle;
  79.     FOnChange: TNotifyEvent;
  80.     FOnUserChange: TNotifyEvent;
  81.     procedure SetButtonSize(Value: Integer);
  82.     procedure SetBorderStyle(Value: TBorderStyle);
  83.     procedure SetHandleColor(Value: TColor);
  84.     procedure SetHighLightColor(Value: TColor);
  85.     procedure SetShadowColor(Value: TColor);
  86.     procedure SetButtonColor(Value: TColor);
  87.     procedure SetBorderColor(Value: TColor);
  88.     procedure SetKind(Value: TScrollBarKind);
  89.     procedure SetShowArrows(Value: Boolean);
  90.     procedure SetShowHandleGrip(Value: Boolean);
  91.     procedure SetStyle(Value: TRBStyle);
  92.     procedure SetBackgnd(Value: TRBBackgnd);
  93. {$IFNDEF CLX}
  94.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  95.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  96.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  97.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  98.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  99. {$ENDIF}
  100.   protected
  101.     GenChange: Boolean;
  102.     DragZone: TRBZone;
  103.     HotZone: TRBZone;
  104.     Timer: TTimer;
  105.     TimerMode: Integer;
  106.     StoredX, StoredY: Integer;
  107.     PosBeforeDrag: Single;
  108.     procedure DoChange; virtual;
  109.     procedure DoDrawButton(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean); virtual;
  110.     procedure DoDrawHandle(R: TRect; Horz: Boolean; Pushed, Hot: Boolean); virtual;
  111.     procedure DoDrawTrack(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean); virtual;
  112. {$IFNDEF CLX}
  113.     procedure DrawNCArea(ADC: HDC; const Clip: HRGN); dynamic;
  114. {$ENDIF}
  115.     function  DrawEnabled: Boolean; virtual;
  116.     function  GetBorderSize: Integer;
  117.     function  GetHandleRect: TRect; virtual;
  118.     function  GetButtonSize: Integer;
  119.     function  GetTrackBoundary: TRect;
  120.     function  GetZone(X, Y: Integer): TRBZone;
  121.     function  GetZoneRect(Zone: TRBZone): TRect;
  122. {$IFDEF CLX}
  123.     procedure MouseLeave(AControl: TControl); override;
  124.     procedure EnabledChanged; override;
  125.     function WidgetFlags: Integer; override;
  126. {$ENDIF}
  127.     procedure MouseLeft; virtual;
  128.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  129.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  130.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  131.     procedure Paint; override;
  132.     procedure StartDragTracking;
  133.     procedure StartHotTracking;
  134.     procedure StopDragTracking;
  135.     procedure StopHotTracking;
  136.     procedure TimerHandler(Sender: TObject); virtual;
  137.   public
  138.     constructor Create(AOwner: TComponent); override;
  139.     property Color default clScrollBar;
  140.     property Backgnd: TRBBackgnd read FBackgnd write SetBackgnd;
  141.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  142.     property ButtonSize: Integer read FButtonSize write SetButtonSize default 0;
  143.     property HandleColor: TColor read FHandleColor write SetHandleColor default clBtnShadow;
  144.     property ButtonColor:TColor read FButtonColor write SetButtonColor default clBtnFace;
  145.     property HighLightColor:TColor read FHighLightColor write SetHighLightColor default clBtnHighlight;
  146.     property ShadowColor:TColor read FShadowColor write SetShadowColor default clBtnShadow;
  147.     property BorderColor:TColor read FBorderColor write SetBorderColor default clWindowFrame;
  148.     property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
  149.     property ShowArrows: Boolean read FShowArrows write SetShowArrows default True;
  150.     property ShowHandleGrip: Boolean read FShowHandleGrip write SetShowHandleGrip;
  151.     property Style: TRBStyle read FStyle write SetStyle default rbsDefault;
  152.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  153.     property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
  154.   end;
  155.  
  156.   TRBIncrement = 1..32768;
  157.  
  158.   TCustomRangeBar = class(TArrowBar)
  159.   private
  160.     FCentered: Boolean;
  161.     FEffectiveWindow: Integer;
  162.     FIncrement: TRBIncrement;
  163.     FPosition: Single;
  164.     FRange: Integer;
  165.     FWindow: Integer;
  166.     function IsPositionStored: Boolean;
  167.     procedure SetPosition(Value: Single);
  168.     procedure SetRange(Value: Integer);
  169.     procedure SetWindow(Value: Integer);
  170.   protected
  171.     procedure AdjustPosition;
  172.     function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  173.       {$IFDEF CLX}const{$ENDIF} MousePos: TPoint): Boolean; override;
  174.     function  DrawEnabled: Boolean; override;
  175.     function  GetHandleRect: TRect; override;
  176.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  177.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  178.     procedure TimerHandler(Sender: TObject); override;
  179.     procedure UpdateEffectiveWindow;
  180.     property EffectiveWindow: Integer read FEffectiveWindow;
  181.   public
  182.     constructor Create(AOwner: TComponent); override;
  183.     procedure Resize; override;
  184.     procedure SetParams(NewRange, NewWindow: Integer);
  185.     property Centered: Boolean read FCentered write FCentered;
  186.     property Increment: TRBIncrement read FIncrement write FIncrement default 8;
  187.     property Position: Single read FPosition write SetPosition stored IsPositionStored;
  188.     property Range: Integer read FRange write SetRange default 0;
  189.     property Window: Integer read FWindow write SetWindow default 0;
  190.   end;
  191.  
  192.   TRangeBar = class(TCustomRangeBar)
  193.   published
  194.     property Align;
  195.     property Anchors;
  196.     property Constraints;
  197.     property Color;
  198.     property Backgnd;
  199.     property BorderStyle;
  200.     property ButtonSize;
  201.     property Enabled;
  202.     property HandleColor;
  203.     property ButtonColor;
  204.     property HighLightColor;
  205.     property ShadowColor;
  206.     property BorderColor;
  207.     property Increment;
  208.     property Kind;
  209.     property Range;
  210.     property Style;
  211.     property Visible;
  212.     property Window;
  213.     property ShowArrows;
  214.     property ShowHandleGrip;
  215.     property Position; // this should be located after the Range property
  216.     property OnChange;
  217.     property OnDragDrop;
  218.     property OnDragOver;
  219.     property OnEndDrag;
  220.     property OnMouseDown;
  221.     property OnMouseMove;
  222.     property OnMouseUp;
  223.     property OnMouseWheelUp;
  224.     property OnMouseWheelDown;
  225.     property OnStartDrag;
  226.     property OnUserChange;
  227.   end;
  228.  
  229.   TCustomGaugeBar = class(TArrowBar)
  230.   private
  231.     FHandleSize: Integer;
  232.     FLargeChange: Integer;
  233.     FMax: Integer;
  234.     FMin: Integer;
  235.     FPosition: Integer;
  236.     FSmallChange: Integer;
  237.     procedure SetHandleSize(Value: Integer);
  238.     procedure SetMax(Value: Integer);
  239.     procedure SetMin(Value: Integer);
  240.     procedure SetPosition(Value: Integer);
  241.     procedure SetLargeChange(Value: Integer);
  242.     procedure SetSmallChange(Value: Integer);
  243.   protected
  244.     procedure AdjustPosition;
  245.     function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  246.       {$IFDEF CLX}const{$ENDIF} MousePos: TPoint): Boolean; override;
  247.     function  GetHandleRect: TRect; override;
  248.     function  GetHandleSize: Integer;
  249.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  250.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  251.     procedure TimerHandler(Sender: TObject); override;
  252.   public
  253.     constructor Create(AOwner: TComponent); override;
  254.     property HandleSize: Integer read FHandleSize write SetHandleSize default 0;
  255.     property LargeChange: Integer read FLargeChange write SetLargeChange default 1;
  256.     property Max: Integer read FMax write SetMax default 100;
  257.     property Min: Integer read FMin write SetMin default 0;
  258.     property Position: Integer read FPosition write SetPosition;
  259.     property SmallChange: Integer read FSmallChange write SetSmallChange default 1;
  260.     property OnChange;
  261.     property OnUserChange;
  262.   end;
  263.  
  264.   TGaugeBar = class(TCustomGaugeBar)
  265.   published
  266.     property Align;
  267.     property Anchors;
  268.     property Constraints;
  269.     property Color;
  270.     property Backgnd;
  271.     property BorderStyle;
  272.     property ButtonSize;
  273.     property Enabled;
  274.     property HandleColor;
  275.     property ButtonColor;
  276.     property HighLightColor;
  277.     property ShadowColor;
  278.     property BorderColor;
  279.     property HandleSize;
  280.     property Kind;
  281.     property LargeChange;
  282.     property Max;
  283.     property Min;
  284.     property ShowArrows;
  285.     property ShowHandleGrip;
  286.     property Style;
  287.     property SmallChange;
  288.     property Visible;
  289.     property Position;
  290.     property OnChange;
  291.     property OnDragDrop;
  292.     property OnDragOver;
  293.     property OnEndDrag;
  294.     property OnMouseDown;
  295.     property OnMouseMove;
  296.     property OnMouseUp;
  297.     property OnStartDrag;
  298.     property OnUserChange;
  299.   end;
  300.  
  301.   { TArrowBarAccess }
  302.   { This class is designed to facilitate access to
  303.     properties of TArrowBar class when creating custom controls, which
  304.     incorporate TArrowBar. It allows controlling up to two arrow bars.
  305.     Master is used to read and write properties, slave - only to write.
  306.  
  307.     Well, maybe it is not so useful itself, but it is a common ancestor
  308.     for TRangeBarAccess and TGaugeBarAccess classes, which work much the
  309.     same way.
  310.  
  311.     When writing a new control, which uses TArrowBar, declare the bar as
  312.     protected member, TArrowBarAccess as published property, and assign
  313.     its Master to the arrow bar }
  314.   TArrowBarAccess = class(TPersistent)
  315.   private
  316.     FMaster: TArrowBar;
  317.     FSlave: TArrowBar;
  318.     function GetBackgnd: TRBBackgnd;
  319.     function GetButtonSize: Integer;
  320.     function GetColor: TColor;
  321.     function GetHandleColor: TColor;
  322.     function GetHighLightColor: TColor;
  323.     function GetButtonColor: TColor;
  324.     function GetBorderColor: TColor;
  325.     function GetShadowColor: TColor;
  326.     function GetShowArrows: Boolean;
  327.     function GetShowHandleGrip: Boolean;
  328.     function GetStyle: TRBStyle;
  329.     procedure SetBackgnd(Value: TRBBackgnd);
  330.     procedure SetButtonSize(Value: Integer);
  331.     procedure SetColor(Value: TColor);
  332.     procedure SetHandleColor(Value: TColor);
  333.     procedure SetShowArrows(Value: Boolean);
  334.     procedure SetShowHandleGrip(Value: Boolean);
  335.     procedure SetStyle(Value: TRBStyle);
  336.     procedure SetHighLightColor(Value: TColor);
  337.     procedure SetShadowColor(Value: TColor);
  338.     procedure SetButtonColor(Value: TColor);
  339.     procedure SetBorderColor(Value: TColor);
  340.   public
  341.     property Master: TArrowBar read FMaster write FMaster;
  342.     property Slave: TArrowBar read FSlave write FSlave;
  343.   published
  344.     property Color: TColor read GetColor write SetColor default clScrollBar;
  345.     property Backgnd: TRBBackgnd read GetBackgnd write SetBackgnd default bgPattern;
  346.     property ButtonSize: Integer read GetButtonSize write SetButtonSize default 0;
  347.     property HandleColor: TColor read GetHandleColor write SetHandleColor default clBtnShadow;
  348.     property ButtonColor:TColor read GetButtonColor write SetButtonColor default clBtnFace;
  349.     property HighLightColor:TColor read GetHighLightColor write SetHighLightColor default clBtnHighlight;
  350.     property ShadowColor:TColor read GetShadowColor write SetShadowColor default clBtnShadow;
  351.     property BorderColor:TColor read GetBorderColor write SetBorderColor default clWindowFrame;
  352.     property ShowArrows: Boolean read GetShowArrows write SetShowArrows default True;
  353.     property ShowHandleGrip: Boolean read GetShowHandleGrip write SetShowHandleGrip;
  354.     property Style: TRBStyle read GetStyle write SetStyle;
  355.   end;
  356.  
  357. implementation
  358.  
  359. uses Math, GR32_System;
  360.  
  361. const
  362.   OppositeDirection: array [TRBDirection] of TRBDirection = (drRight, drDown, drLeft, drUp);
  363.   tmScrollFirst = 1;
  364.   tmScroll = 2;
  365.   tmHotTrack = 3;
  366.  
  367. function ClrLighten(C: TColor; Amount: Integer): TColor;
  368. var
  369.   R, G, B: Integer;
  370. begin
  371. {$IFDEF CLX}
  372.   C := ColorToRGB(C);
  373. {$ELSE}
  374.   if C < 0 then C := GetSysColor(C and $000000FF);
  375. {$ENDIF}
  376.   R := C and $FF + Amount;
  377.   G := C shr 8 and $FF + Amount;
  378.   B := C shr 16 and $FF + Amount;
  379.   if R < 0 then R := 0 else if R > 255 then R := 255;
  380.   if G < 0 then G := 0 else if G > 255 then G := 255;
  381.   if B < 0 then B := 0 else if B > 255 then B := 255;
  382.   Result := R or (G shl 8) or (B shl 16);
  383. end;
  384.  
  385. function MixColors(C1, C2: TColor; W1: Integer): TColor;
  386. var
  387.   W2: Cardinal;
  388. begin
  389.   Assert(W1 in [0..255]);
  390.   W2 := W1 xor 255;
  391. {$IFDEF CLX}
  392.   C1 := ColorToRGB(C1);
  393.   C2 := ColorToRGB(C2);
  394. {$ELSE}
  395.   if Integer(C1) < 0 then C1 := GetSysColor(C1 and $000000FF);
  396.   if Integer(C2) < 0 then C2 := GetSysColor(C2 and $000000FF);
  397. {$ENDIF}
  398.   Result := Integer(
  399.     ((Cardinal(C1) and $FF00FF) * Cardinal(W1) +
  400.     (Cardinal(C2) and $FF00FF) * W2) and $FF00FF00 +
  401.     ((Cardinal(C1) and $00FF00) * Cardinal(W1) +
  402.     (Cardinal(C2) and $00FF00) * W2) and $00FF0000) shr 8;
  403. end;
  404.  
  405. procedure DitherRect(Canvas: TCanvas; const R: TRect; C1, C2: TColor);
  406. var
  407.   B: TBitmap;
  408. {$IFNDEF CLX}
  409.   Brush: HBRUSH;
  410. {$ELSE}
  411.   Brush: TBrush;
  412.   OldBrush: TBrush;
  413. {$ENDIF}
  414. begin
  415.   if IsRectEmpty(R) then Exit;
  416. {$IFDEF CLX}
  417.   Brush := TBrush.Create;
  418.   if C1 = C2 then
  419.   begin
  420.     Brush.Color := ColorToRGB(C1);
  421.   end
  422.   else
  423.   begin
  424.     B := AllocPatternBitmap(C1, C2);
  425.     Brush.Bitmap := B;
  426.   end;
  427.   OldBrush := TBrush.Create;
  428.   OldBrush.Assign(Canvas.Brush);
  429.   Canvas.Brush.Assign(Brush);
  430.   Canvas.FillRect(R);
  431.   Canvas.Brush.Assign(OldBrush);
  432.   Brush.Free;
  433.   OldBrush.Free;
  434. {$ELSE}
  435.   if C1 = C2 then
  436.     Brush := CreateSolidBrush(ColorToRGB(C1))
  437.   else
  438.   begin
  439.     B := AllocPatternBitmap(C1, C2);
  440.     B.HandleType := bmDDB;
  441.     Brush := CreatePatternBrush(B.Handle);
  442.   end;
  443.   FillRect(Canvas.Handle, R, Brush);
  444.   DeleteObject(Brush);
  445. {$ENDIF}
  446. end;
  447.  
  448. procedure DrawRectEx(Canvas: TCanvas; var R: TRect; Sides: TRBDirections; C: TColor);
  449. begin
  450.   if Sides <> [] then with Canvas, R do
  451.   begin
  452.     Pen.Color := C;
  453.     if drUp in Sides then
  454.     begin
  455.       MoveTo(Left, Top); LineTo(Right, Top); Inc(Top);
  456.     end;
  457.     if drDown in Sides then
  458.     begin
  459.       Dec(Bottom); MoveTo(Left, Bottom); LineTo(Right, Bottom);
  460.     end;
  461.     if drLeft in Sides then
  462.     begin
  463.       MoveTo(Left, Top); LineTo(Left, Bottom); Inc(Left);
  464.     end;
  465.     if drRight in Sides then
  466.     begin
  467.       Dec(Right); MoveTo(Right, Top); LineTo(Right, Bottom);
  468.     end;
  469.   end;
  470. end;
  471.  
  472. {$IFDEF CLX}
  473. procedure FrameRect(Canvas: TCanvas; const R: TRect);
  474. begin
  475.   with Canvas, R do
  476.     Rectangle(Left, Top, Right, Bottom);
  477. end;
  478. {$ENDIF}
  479.  
  480. procedure Frame3D(Canvas: TCanvas; var ARect: TRect; TopColor, BottomColor: TColor; AdjustRect: Boolean = True);
  481. var
  482.   TopRight, BottomLeft: TPoint;
  483. begin
  484.   with Canvas, ARect do
  485.   begin
  486.     Pen.Width := 1;
  487.     Dec(Bottom); Dec(Right);
  488.     TopRight.X := Right;
  489.     TopRight.Y := Top;
  490.     BottomLeft.X := Left;
  491.     BottomLeft.Y := Bottom;
  492.     Pen.Color := TopColor;
  493.     PolyLine([BottomLeft, TopLeft, TopRight]);
  494.     Pen.Color := BottomColor;
  495.     Dec(Left);
  496.     PolyLine([TopRight, BottomRight, BottomLeft]);
  497.     if AdjustRect then
  498.     begin
  499.       Inc(Top); Inc(Left, 2);
  500.     end
  501.     else
  502.     begin
  503.       Inc(Left); Inc(Bottom); Inc(Right);
  504.     end;
  505.   end;
  506. end;
  507.  
  508. procedure DrawHandle(Canvas: TCanvas; R: TRect; Color: TColor;
  509.   Pushed, ShowGrip, IsHorz: Boolean; ColorBorder: TColor);
  510. var
  511.   CHi, CLo: TColor;
  512.   I, S: Integer;
  513. begin
  514.   CHi := ClrLighten(Color, 24);
  515.   CLo := ClrLighten(Color, -24);
  516.  
  517. {$IFDEF CLX}
  518.   Canvas.Pen.Color := ColorBorder;  // CLX FrameRect function is using Pen instead of Brush
  519.   FrameRect(Canvas, R);
  520. {$ELSE}
  521.   Canvas.Brush.Color := ColorBorder;
  522.   FrameRect(Canvas.Handle, R, Canvas.Brush.Handle);
  523. {$ENDIF}
  524.  
  525.   InflateRect(R, -1, -1);
  526.   if Pushed then Frame3D(Canvas, R, CLo, Color)
  527.   else Frame3D(Canvas, R, CHi, MixColors(ColorBorder, Color, 96));
  528.   Canvas.Brush.Color := Color;
  529.   Canvas.FillRect(R);
  530.  
  531.   if ShowGrip then
  532.   begin
  533.     if Pushed then OffsetRect(R, 1, 1);
  534.     if IsHorz then
  535.     begin
  536.       S := R.Right - R.Left;
  537.       R.Left := (R.Left + R.Right) div 2 - 5;
  538.       R.Right := R.Left + 2;
  539.       Inc(R.Top); Dec(R.Bottom);
  540.  
  541.       if S > 10 then Frame3D(Canvas, R, CHi, CLo, False);
  542.       Inc(R.Left, 3); Inc(R.Right, 3);
  543.       Frame3D(Canvas, R, CHi, CLo, False);
  544.       Inc(R.Left, 3); Inc(R.Right, 3);
  545.       Frame3D(Canvas, R, CHi, CLo, False);
  546.       Inc(R.Left, 3); Inc(R.Right, 3);
  547.       if S > 10 then Frame3D(Canvas, R, CHi, CLo, False);
  548.     end
  549.     else
  550.     begin
  551.       I := (R.Top + R.Bottom) div 2;
  552.       S := R.Bottom - R.Top;
  553.       R.Top := I - 1;
  554.       R.Bottom := I + 1;
  555.       Dec(R.Right);
  556.       Inc(R.Left);
  557.  
  558.       OffsetRect(R, 0, -4);
  559.       if S > 10 then
  560.       begin
  561.         Frame3D(Canvas, R, CHi, CLo, False);
  562.       end;
  563.  
  564.       OffsetRect(R, 0, 3);
  565.       Frame3D(Canvas, R, CHi, CLo, False);
  566.  
  567.       OffsetRect(R, 0, 3);
  568.       Frame3D(Canvas, R, CHi, CLo, False);
  569.  
  570.       if S > 10 then
  571.       begin
  572.         OffsetRect(R, 0, 3);
  573.         Frame3D(Canvas, R, CHi, CLo, False);
  574.       end;
  575.     end;
  576.   end;
  577. end;
  578.  
  579. procedure DrawArrow(Canvas: TCanvas; R: TRect; Direction: TRBDirection; Color: TColor);
  580. var
  581.   X, Y, Sz, Shift: Integer;
  582. begin
  583.   X := (R.Left + R.Right - 1) div 2;
  584.   Y := (R.Top + R.Bottom - 1) div 2;
  585.   Sz := (Min(X - R.Left, Y - R.Top)) * 3 div 4 - 1;
  586.   if Sz = 0 then Sz := 1;
  587.   if Direction in [drUp, drLeft] then Shift := (Sz + 1) * 1 div 3
  588.   else Shift := Sz * 1 div 3;
  589.   Canvas.Pen.Color := Color;
  590.   Canvas.Brush.Color := Color;
  591.   case Direction of
  592.     drUp:
  593.       begin
  594.         Inc(Y, Shift);
  595.         Canvas.Polygon([Point(X + Sz, Y), Point(X, Y - Sz), Point(X - Sz, Y)]);
  596.       end;
  597.     drDown:
  598.       begin
  599.         Dec(Y, Shift);
  600.         Canvas.Polygon([Point(X + Sz, Y), Point(X, Y + Sz), Point(X - Sz, Y)]);
  601.       end;
  602.     drLeft:
  603.       begin
  604.         Inc(X, Shift);
  605.         Canvas.Polygon([Point(X, Y + Sz), Point(X - Sz, Y), Point(X, Y - Sz)]);
  606.       end;
  607.     drRight:
  608.       begin
  609.         Dec(X, Shift);
  610.         Canvas.Polygon([Point(X, Y + Sz), Point(X + Sz, Y), Point(X, Y - Sz)]);
  611.       end;
  612.   end;
  613. end;
  614.  
  615. const
  616.   FIRST_DELAY = 600;
  617.   SCROLL_INTERVAL = 100;
  618.   HOTTRACK_INTERVAL = 150;
  619.   MIN_SIZE = 17;
  620.  
  621. { TArrowBar }
  622.  
  623. {$IFDEF CLX}
  624. procedure TArrowBar.EnabledChanged;
  625. {$ELSE}
  626. procedure TArrowBar.CMEnabledChanged(var Message: TMessage);
  627. {$ENDIF}
  628. begin
  629.   inherited;
  630.   Invalidate;
  631. end;
  632.  
  633. {$IFDEF CLX}
  634. procedure TArrowBar.MouseLeave(AControl: TControl);
  635. {$ELSE}
  636. procedure TArrowBar.CMMouseLeave(var Message: TMessage);
  637. {$ENDIF}
  638. begin
  639.   MouseLeft;
  640. end;
  641.  
  642. constructor TArrowBar.Create(AOwner: TComponent);
  643. begin
  644.   inherited;
  645.   ControlStyle := ControlStyle - [csAcceptsControls, csDoubleClicks] + [csOpaque];
  646.   Width := 100;
  647.   Height := 16;
  648.   ParentColor := False;
  649.   Color := clScrollBar;
  650.   Timer := TTimer.Create(Self);
  651.   Timer.OnTimer := TimerHandler;
  652.   FShowArrows := True;
  653.   FBorderStyle := bsSingle;
  654.   FHandleColor := clBtnShadow;
  655.   FButtonColor := clBtnFace;
  656.   FHighLightColor := clBtnHighlight;
  657.   FShadowColor := clBtnShadow;
  658.   FBorderColor := clWindowFrame;
  659.   FShowHandleGrip := True;
  660. end;
  661.  
  662. procedure TArrowBar.DoChange;
  663. begin
  664.   if Assigned(FOnChange) then FOnChange(Self);
  665.   if GenChange and Assigned(FOnUserChange) then FOnUserChange(Self);
  666. end;
  667.  
  668. procedure TArrowBar.DoDrawButton(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean);
  669. const
  670.   EnabledFlags: array [Boolean] of Integer = (DFCS_INACTIVE, 0);
  671.   PushedFlags: array [Boolean] of Integer = (0, DFCS_PUSHED or DFCS_FLAT);
  672.   DirectionFlags: array [TRBDirection] of Integer = (DFCS_SCROLLLEFT, DFCS_SCROLLUP,
  673.     DFCS_SCROLLRIGHT, DFCS_SCROLLDOWN);
  674. {$IFNDEF CLX}
  675.   DirectionXPFlags: array [TRBDirection] of Cardinal = (ABS_LEFTNORMAL, ABS_UPNORMAL,
  676.     ABS_RIGHTNORMAL, ABS_DOWNNORMAL);
  677. {$ENDIF}
  678. var
  679.   Edges: TRBDirections;
  680. {$IFNDEF CLX}
  681.   Flags: Integer;
  682. {$ENDIF}
  683. begin
  684.   if Style = rbsDefault then
  685.   begin
  686. {$IFDEF CLX}
  687.     Canvas.Brush.Color := clButton;
  688.     Canvas.FillRect(R);
  689.     DrawWinButton(Canvas, R, Pushed);
  690.     InflateRect(R, -2, -2);
  691.  
  692.     If not DrawEnabled then
  693.     begin
  694.       InflateRect(R, -1, -1);
  695.       OffsetRect(R, 1, 1);
  696.       DrawArrow(Canvas, R, Direction, clWhite);
  697.       OffsetRect(R, -1, -1);
  698.       DrawArrow(Canvas, R, Direction, clDisabledButtonText);
  699.     end
  700.     else
  701.     begin
  702.       If Pushed then OffsetRect(R, 1, 1);
  703.       DrawArrow(Canvas, R, Direction, clButtonText);
  704.     end;
  705. {$ELSE}
  706.     if USE_THEMES then
  707.     begin
  708.       Flags := DirectionXPFlags[Direction];
  709.       if not Enabled then Inc(Flags, 3)
  710.       else if Pushed then Inc(Flags, 2)
  711.       else if Hot then Inc(Flags);
  712.       DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, SBP_ARROWBTN, Flags, R, nil);
  713.     end
  714.     else
  715.       DrawFrameControl(Canvas.Handle, R, DFC_SCROLL,
  716.         DirectionFlags[Direction] or EnabledFlags[DrawEnabled] or PushedFlags[Pushed])
  717. {$ENDIF}
  718.   end
  719.   else
  720.   begin
  721.     Edges := [drLeft, drUp, drRight, drDown];
  722.     Exclude(Edges, OppositeDirection[Direction]);
  723.  
  724.     if not DrawEnabled then
  725.     begin
  726.       DrawRectEx(Canvas, R, Edges, fShadowColor);
  727.       Canvas.Brush.Color := fButtonColor;
  728. {$IFDEF CLX}
  729.       Canvas.FillRect(R);
  730. {$ELSE}
  731.       FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
  732. {$ENDIF}
  733.       InflateRect(R, -1, -1);
  734.       OffsetRect(R, 1, 1);
  735.       DrawArrow(Canvas, R, Direction, fHighLightColor);
  736.       OffsetRect(R, -1, -1);
  737.       DrawArrow(Canvas, R, Direction, fShadowColor);
  738.     end
  739.     else
  740.     begin
  741.       DrawRectEx(Canvas, R, Edges, fBorderColor);
  742.       if Pushed then
  743.       begin
  744.         Canvas.Brush.Color := fButtonColor;
  745. {$IFDEF CLX}
  746.         Canvas.FillRect(R);
  747. {$ELSE}
  748.         FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
  749. {$ENDIF}
  750.         OffsetRect(R, 1, 1);
  751.         InflateRect(R, -1, -1);
  752.       end
  753.       else
  754.       begin
  755.         Frame3D(Canvas, R, fHighLightColor, fShadowColor, True);
  756.         Canvas.Brush.Color := fButtonColor;
  757. {$IFDEF CLX}
  758.         Canvas.FillRect(R);
  759. {$ELSE}
  760.         FillRect(Canvas.Handle, R, Canvas.Brush.Handle);
  761. {$ENDIF}
  762.       end;
  763.       DrawArrow(Canvas, R, Direction, fBorderColor);
  764.     end;
  765.   end;
  766. end;
  767.  
  768. procedure TArrowBar.DoDrawHandle(R: TRect; Horz, Pushed, Hot: Boolean);
  769. {$IFNDEF CLX}
  770. const
  771.   PartXPFlags: array [Boolean] of Cardinal = (SBP_THUMBBTNVERT, SBP_THUMBBTNHORZ);
  772.   GripperFlags: array [Boolean] of Cardinal = (SBP_GRIPPERVERT, SBP_GRIPPERHORZ);
  773. var
  774.   Flags: Cardinal;
  775. {$ENDIF}
  776. begin
  777.   if IsRectEmpty(R) then Exit;
  778.   case Style of
  779.     rbsDefault:
  780. {$IFNDEF CLX}
  781.       if USE_THEMES then
  782.       begin
  783.         Flags := SCRBS_NORMAL;
  784.         if not Enabled then Inc(Flags, 3)
  785.         else if Pushed then Inc(Flags, 2)
  786.         else if Hot then Inc(Flags);
  787.         DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, PartXPFlags[Horz], Flags, R, nil);
  788.         if ShowHandleGrip then
  789.           DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, GripperFlags[Horz], 0, R, nil);
  790.       end
  791.       else
  792.         DrawEdge(Canvas.Handle, R, EDGE_RAISED, BF_RECT or BF_MIDDLE);
  793. {$ELSE}
  794.       begin
  795.         Canvas.Brush.Color := clButton;
  796.         Canvas.FillRect(R);
  797.         DrawWinButton(Canvas, R, False);
  798.       end;
  799. {$ENDIF}
  800.     rbsMac:
  801.       DrawHandle(Canvas, R, HandleColor, Pushed, ShowHandleGrip, Horz, fBorderColor);
  802.   end;
  803. end;
  804.  
  805. procedure TArrowBar.DoDrawTrack(R: TRect; Direction: TRBDirection; Pushed, Enabled, Hot: Boolean);
  806. {$IFNDEF CLX}
  807. const
  808.   PartXPFlags: array [TRBDirection] of Cardinal =
  809.     (SBP_LOWERTRACKHORZ, SBP_LOWERTRACKVERT, SBP_UPPERTRACKHORZ, SBP_UPPERTRACKVERT);
  810. {$ENDIF}
  811. var
  812. {$IFNDEF CLX}
  813.   Flags: Cardinal;
  814. {$ENDIF}
  815.   C: TColor;
  816.   Edges: set of TRBDirection;
  817. begin
  818.   if (R.Right <= R.Left) or (R.Bottom <= R.Top) then Exit;
  819.   if Style = rbsDefault then
  820.   begin
  821. {$IFNDEF CLX}
  822.     if USE_THEMES then
  823.     begin
  824.       Flags := SCRBS_NORMAL;
  825.       if Pushed then Inc(Flags, 2);
  826.       DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, PartXPFlags[Direction], Flags, R, nil);
  827.     end
  828.     else
  829. {$ENDIF}
  830.     begin
  831.       if Pushed then DitherRect(Canvas, R, clWindowFrame, clWindowFrame)
  832.       else DitherRect(Canvas, R, clBtnHighlight, Color);
  833.     end;
  834.   end
  835.   else
  836.   with Canvas, R do
  837.   begin
  838.     if DrawEnabled then C := FBorderColor
  839.     else C := FShadowColor;
  840.     Edges := [drLeft, drUp, drRight, drDown];
  841.     Exclude(Edges, OppositeDirection[Direction]);
  842.     DrawRectEx(Canvas, R, Edges, C);
  843.     if Pushed then DitherRect(Canvas, R, fBorderColor,fBorderColor)
  844.     else if not IsRectEmpty(R) then with R do
  845.     begin
  846.       if DrawEnabled then
  847.       begin
  848.         Pen.Color := MixColors(fBorderColor, MixColors(fHighLightColor, Color, 127), 32);
  849.         case Direction of
  850.           drLeft, drUp:
  851.             begin
  852.               MoveTo(Left, Bottom - 1); LineTo(Left, Top); LineTo(Right, Top);
  853.               Inc(Top); Inc(Left);
  854.             end;
  855.           drRight:
  856.             begin
  857.               MoveTo(Left, Top); LineTo(Right, Top);
  858.               Inc(Top);
  859.             end;
  860.           drDown:
  861.             begin
  862.               MoveTo(Left, Top); LineTo(Left, Bottom);
  863.               Inc(Left);
  864.             end;
  865.         end;
  866.         if Backgnd = bgPattern then DitherRect(Canvas, R, fHighLightColor, Color)
  867.         else DitherRect(Canvas, R, Color, Color);
  868.       end
  869.       else
  870.       begin
  871.         Brush.Color := fButtonColor;
  872.         FillRect(R);
  873.       end;
  874.     end;
  875.   end;
  876. end;
  877.  
  878. function TArrowBar.DrawEnabled: Boolean;
  879. begin
  880.   Result := Enabled;
  881. end;
  882.  
  883. {$IFNDEF CLX}
  884. procedure TArrowBar.DrawNCArea(ADC: HDC; const Clip: HRGN);
  885. var
  886.   DC: HDC;
  887.   R: TRect;
  888. begin
  889.   if BorderStyle = bsNone then Exit;
  890.   if ADC = 0 then DC := GetWindowDC(Handle)
  891.   else DC := ADC;
  892.   try
  893.     GetWindowRect(Handle, R);
  894.     OffsetRect(R, -R.Left, -R.Top);
  895.     DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
  896.   finally
  897.     if ADC = 0 then ReleaseDC(Handle, DC);
  898.   end;
  899. end;
  900. {$ENDIF}
  901.  
  902. function TArrowBar.GetBorderSize: Integer;
  903. const
  904.   CSize: array [Boolean] of Integer = (0, 1);
  905. begin
  906.   Result := CSize[BorderStyle = bsSingle];
  907. end;
  908.  
  909. function TArrowBar.GetButtonSize: Integer;
  910. var
  911.   W, H: Integer;
  912. begin
  913.   if not ShowArrows then Result := 0
  914.   else
  915.   begin
  916.     Result := ButtonSize;
  917.     if Kind = sbHorizontal then
  918.     begin
  919.       W := ClientWidth;
  920.       H := ClientHeight;
  921.     end
  922.     else
  923.     begin
  924.       W := ClientHeight;
  925.       H := ClientWidth;
  926.     end;
  927.     if Result = 0 then Result := Min(H, 32);
  928.     if Result * 2 >= W then Result := W div 2;
  929.     if Style = rbsMac then Dec(Result);
  930.     if Result < 2 then Result := 0;
  931.   end;
  932. end;
  933.  
  934. function TArrowBar.GetHandleRect: TRect;
  935. begin
  936.   Result := Rect(0, 0, 0, 0);
  937. end;
  938.  
  939. function TArrowBar.GetTrackBoundary: TRect;
  940. begin
  941.   Result := ClientRect;
  942.   if Kind = sbHorizontal then InflateRect(Result, -GetButtonSize, 0)
  943.   else InflateRect(Result, 0, -GetButtonSize);
  944. end;
  945.  
  946. function TArrowBar.GetZone(X, Y: Integer): TRBZone;
  947. var
  948.   P: TPoint;
  949.   R, R1: TRect;
  950.   Sz: Integer;
  951. begin
  952.   Result := zNone;
  953.  
  954.   P := Point(X, Y);
  955.   R := ClientRect;
  956.   if not PtInrect(R, P) then Exit;
  957.  
  958.   Sz := GetButtonSize;
  959.   R1 := R;
  960.   if Kind = sbHorizontal then
  961.   begin
  962.     R1.Right := R1.Left + Sz;
  963.     if PtInRect(R1, P) then Result := zBtnPrev
  964.     else
  965.     begin
  966.       R1.Right := R.Right;
  967.       R1.Left := R.Right - Sz;
  968.       if PtInRect(R1, P) then Result := zBtnNext;
  969.     end;
  970.   end
  971.   else
  972.   begin
  973.     R1.Bottom := R1.Top + Sz;
  974.     if PtInRect(R1, P) then Result := zBtnPrev
  975.     else
  976.     begin
  977.       R1.Bottom := R.Bottom;
  978.       R1.Top := R.Bottom - Sz;
  979.       if PtInRect(R1, P) then Result := zBtnNext;
  980.     end;
  981.   end;
  982.  
  983.   if Result = zNone then
  984.   begin
  985.     R := GetHandleRect;
  986.     P := Point(X, Y);
  987.     if PtInRect(R, P) then Result := zHandle
  988.     else
  989.     begin
  990.       if Kind = sbHorizontal then
  991.       begin
  992.         if (X > 0) and (X < R.Left) then Result := zTrackPrev
  993.         else if (X >= R.Right) and (X < ClientWidth - 1) then Result := zTrackNext;
  994.       end
  995.       else
  996.       begin
  997.         if (Y > 0) and (Y < R.Top) then Result := zTrackPrev
  998.         else if (Y >= R.Bottom) and (Y < ClientHeight - 1) then Result := zTrackNext;
  999.       end;
  1000.     end;
  1001.   end;
  1002. end;
  1003.  
  1004. function TArrowBar.GetZoneRect(Zone: TRBZone): TRect;
  1005. const
  1006.   CEmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
  1007. var
  1008.   BtnSize: Integer;
  1009.   Horz: Boolean;
  1010.   R: TRect;
  1011. begin
  1012.   Horz := Kind = sbHorizontal;
  1013.   BtnSize:= GetButtonSize;
  1014.   case Zone of
  1015.     zNone: Result := CEmptyRect;
  1016.     zBtnPrev:
  1017.       begin
  1018.         Result := ClientRect;
  1019.         if Horz then Result.Right := Result.Left + BtnSize
  1020.         else Result.Bottom := Result.Top + BtnSize;
  1021.       end;
  1022.     zTrackPrev..zTrackNext:
  1023.       begin
  1024.         Result := GetTrackBoundary;
  1025.         R := GetHandleRect;
  1026.         if not DrawEnabled or IsRectEmpty(R) then
  1027.         begin
  1028.           R.Left := (Result.Left + Result.Right) div 2;
  1029.           R.Top := (Result.Top + Result.Bottom) div 2;
  1030.           R.Right := R.Left;
  1031.           R.Bottom := R.Top;
  1032.         end;
  1033.         case Zone of
  1034.           zTrackPrev:
  1035.             if Horz then Result.Right := R.Left
  1036.             else Result.Bottom := R.Top;
  1037.           zHandle:
  1038.             Result := R;
  1039.           zTrackNext:
  1040.             if Horz then Result.Left := R.Right
  1041.             else Result.Top := R.Bottom;
  1042.         end;
  1043.       end;
  1044.     zBtnNext:
  1045.       begin
  1046.         Result := ClientRect;
  1047.         if Horz then Result.Left := Result.Right - BtnSize
  1048.         else Result.Top := Result.Bottom - BtnSize;
  1049.       end;
  1050.   end;
  1051. end;
  1052.  
  1053. procedure TArrowBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1054. begin
  1055.   inherited;
  1056.   if Button <> mbLeft then Exit;
  1057.   DragZone := GetZone(X, Y);
  1058.   Invalidate;
  1059.   StoredX := X;
  1060.   StoredY := Y;
  1061.   StartDragTracking;
  1062. end;
  1063.  
  1064. procedure TArrowBar.MouseLeft;
  1065. begin
  1066.   StopHotTracking;
  1067. end;
  1068.  
  1069. procedure TArrowBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  1070. var
  1071.   NewHotZone: TRBZone;
  1072. begin
  1073.   inherited;
  1074.   if (DragZone = zNone) and DrawEnabled then
  1075.   begin
  1076.     NewHotZone := GetZone(X, Y);
  1077.     if NewHotZone <> HotZone then
  1078.     begin
  1079.       HotZone := NewHotZone;
  1080.       if HotZone <> zNone then StartHotTracking;
  1081.       Invalidate;
  1082.     end;
  1083.   end;
  1084. end;
  1085.  
  1086. procedure TArrowBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1087. begin
  1088.   inherited;
  1089.   DragZone := zNone;
  1090.   Invalidate;
  1091.   StopDragTracking;
  1092. end;
  1093.  
  1094. procedure TArrowBar.Paint;
  1095. const
  1096.   CPrevDirs: array [Boolean] of TRBDirection = (drUp, drLeft);
  1097.   CNextDirs: array [Boolean] of TRBDirection = (drDown, drRight);
  1098. var
  1099.   BSize: Integer;
  1100.   ShowEnabled: Boolean;
  1101.   R, BtnRect, HandleRect: TRect;
  1102.   Horz, ShowHandle: Boolean;
  1103. begin
  1104.   R := ClientRect;
  1105.   Horz := Kind = sbHorizontal;
  1106.   ShowEnabled := DrawEnabled;
  1107.   BSize := GetButtonSize;
  1108.  
  1109.   if ShowArrows then
  1110.   begin
  1111.     { left / top button }
  1112.     BtnRect := R;
  1113.     with BtnRect do if Horz then Right := Left + BSize else Bottom := Top + BSize;
  1114.     DoDrawButton(BtnRect, CPrevDirs[Horz], DragZone = zBtnPrev, ShowEnabled, HotZone = zBtnPrev);
  1115.  
  1116.     { right / bottom button }
  1117.     BtnRect := R;
  1118.     with BtnRect do if Horz then Left := Right - BSize else Top := Bottom - BSize;
  1119.     DoDrawButton(BtnRect, CNextDirs[Horz], DragZone = zBtnNext, ShowEnabled, HotZone = zBtnNext);
  1120.   end;
  1121.  
  1122.   if Horz then InflateRect(R, -BSize, 0) else InflateRect(R, 0, -BSize);
  1123.   if ShowEnabled then HandleRect := GetHandleRect
  1124.   else HandleRect := Rect(0, 0, 0, 0);
  1125.   ShowHandle := not IsRectEmpty(HandleRect);
  1126.  
  1127.   DoDrawTrack(GetZoneRect(zTrackPrev), CPrevDirs[Horz], DragZone = zTrackPrev, ShowEnabled, HotZone = zTrackPrev);
  1128.   DoDrawTrack(GetZoneRect(zTrackNext), CNextDirs[Horz], DragZone = zTrackNext, ShowEnabled, HotZone = zTrackNext);
  1129.   if ShowHandle then DoDrawHandle(HandleRect, Horz, DragZone = zHandle, HotZone = zHandle);
  1130. end;
  1131.  
  1132. procedure TArrowBar.SetBackgnd(Value: TRBBackgnd);
  1133. begin
  1134.   if Value <> FBackgnd then
  1135.   begin
  1136.     FBackgnd := Value;
  1137.     Invalidate;
  1138.   end;
  1139. end;
  1140.  
  1141. procedure TArrowBar.SetBorderStyle(Value: TBorderStyle);
  1142. begin
  1143.   if Value <> FBorderStyle then
  1144.   begin
  1145.     FBorderStyle := Value;
  1146. {$IFDEF CLX}
  1147.     Invalidate;
  1148. {$ELSE}
  1149.     RecreateWnd;
  1150. {$ENDIF}
  1151.   end;
  1152. end;
  1153.  
  1154. procedure TArrowBar.SetButtonSize(Value: Integer);
  1155. begin
  1156.   if Value <> FButtonSize then
  1157.   begin
  1158.     FButtonSize := Value;
  1159.     Invalidate;
  1160.   end;
  1161. end;
  1162.  
  1163. procedure TArrowBar.SetHandleColor(Value: TColor);
  1164. begin
  1165.   if Value <> FHandleColor then
  1166.   begin
  1167.     FHandleColor := Value;
  1168.     Invalidate;
  1169.   end;
  1170. end;
  1171.  
  1172. procedure TArrowBar.SetHighLightColor(Value: TColor);
  1173. begin
  1174.   if Value <> FHighLightColor then
  1175.   begin
  1176.     FHighLightColor := Value;
  1177.     Invalidate;
  1178.   end;
  1179. end;
  1180.  
  1181. procedure TArrowBar.SetButtonColor(Value: TColor);
  1182. begin
  1183.   if Value <> FButtonColor then
  1184.   begin
  1185.     FButtonColor := Value;
  1186.     Invalidate;
  1187.   end;
  1188. end;
  1189.  
  1190. procedure TArrowBar.SetBorderColor(Value: TColor);
  1191. begin
  1192.   if Value <> FBorderColor then
  1193.   begin
  1194.     FBorderColor := Value;
  1195.     Invalidate;
  1196.   end;
  1197. end;
  1198.  
  1199. procedure TArrowBar.SetShadowColor(Value: TColor);
  1200. begin
  1201.   if Value <> FShadowColor then
  1202.   begin
  1203.     FShadowColor := Value;
  1204.     Invalidate;
  1205.   end;
  1206. end;
  1207.  
  1208. procedure TArrowBar.SetKind(Value: TScrollBarKind);
  1209. var
  1210.   Tmp: Integer;
  1211. begin
  1212.   if Value <> FKind then
  1213.   begin
  1214.     FKind := Value;
  1215.     if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
  1216.     begin
  1217.       Tmp := Width;
  1218.       Width := Height;
  1219.       Height := Tmp;
  1220.     end;
  1221.     Invalidate;
  1222.   end;
  1223. end;
  1224.  
  1225. procedure TArrowBar.SetShowArrows(Value: Boolean);
  1226. begin
  1227.   if Value <> FShowArrows then
  1228.   begin
  1229.     FShowArrows := Value;
  1230.     Invalidate;
  1231.   end;
  1232. end;
  1233.  
  1234. procedure TArrowBar.SetShowHandleGrip(Value: Boolean);
  1235. begin
  1236.   if Value <> FShowHandleGrip then
  1237.   begin
  1238.     FShowHandleGrip := Value;
  1239.     Invalidate;
  1240.   end;
  1241. end;
  1242.  
  1243. procedure TArrowBar.SetStyle(Value: TRBStyle);
  1244. begin
  1245.   FStyle := Value;
  1246. {$IFDEF CLX}
  1247.   Invalidate;
  1248. {$ELSE}
  1249.   RecreateWnd;
  1250. {$ENDIF}
  1251. end;
  1252.  
  1253. procedure TArrowBar.StartDragTracking;
  1254. begin
  1255.   Timer.Interval := FIRST_DELAY;
  1256.   TimerMode := tmScroll;
  1257.   TimerHandler(Self);
  1258.   TimerMode := tmScrollFirst;
  1259.   Timer.Enabled := True;
  1260. end;
  1261.  
  1262. procedure TArrowBar.StartHotTracking;
  1263. begin
  1264.   Timer.Interval := HOTTRACK_INTERVAL;
  1265.   TimerMode := tmHotTrack;
  1266.   Timer.Enabled := True;
  1267. end;
  1268.  
  1269. procedure TArrowBar.StopDragTracking;
  1270. begin
  1271.   StartHotTracking;
  1272. end;
  1273.  
  1274. procedure TArrowBar.StopHotTracking;
  1275. begin
  1276.   Timer.Enabled := False;
  1277.   HotZone := zNone;
  1278.   Invalidate;
  1279. end;
  1280.  
  1281. procedure TArrowBar.TimerHandler(Sender: TObject);
  1282. var
  1283.   Pt: TPoint;
  1284. begin
  1285.   case TimerMode of
  1286.     tmScrollFirst:
  1287.       begin
  1288.         Timer.Interval := SCROLL_INTERVAL;
  1289.         TimerMode := tmScroll;
  1290.       end;
  1291.     tmHotTrack:
  1292.       begin
  1293.         Pt := ScreenToClient(Mouse.CursorPos);
  1294.         if not PtInRect(ClientRect, Pt) then
  1295.         begin
  1296.           StopHotTracking;
  1297.           Invalidate;
  1298.         end;
  1299.       end;
  1300.   end;
  1301. end;
  1302.  
  1303. {$IFNDEF CLX}
  1304. procedure TArrowBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
  1305. begin
  1306.   Message.Result := -1;
  1307. end;
  1308.  
  1309. procedure TArrowBar.WMNCCalcSize(var Message: TWMNCCalcSize);
  1310. var
  1311.   Sz: Integer;
  1312. begin
  1313.   Sz := GetBorderSize;
  1314.   InflateRect(Message.CalcSize_Params.rgrc[0], -Sz, -Sz);
  1315. end;
  1316.  
  1317. procedure TArrowBar.WMNCPaint(var Message: TMessage);
  1318. begin
  1319.   DrawNCArea(0, HRGN(Message.WParam));
  1320. end;
  1321. {$ELSE}
  1322.  
  1323. function TArrowBar.WidgetFlags: Integer;
  1324. begin
  1325.   Result := Inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase) or
  1326.     Integer(WidgetFlags_WResizeNoErase);
  1327. end;
  1328. {$ENDIF}
  1329.  
  1330. { TCustomRangeBar }
  1331.  
  1332. procedure TCustomRangeBar.AdjustPosition;
  1333. begin
  1334.   if FPosition > Range - EffectiveWindow then FPosition := Range - EffectiveWindow;
  1335.   if FPosition < 0 then FPosition := 0;
  1336. end;
  1337.  
  1338. constructor TCustomRangeBar.Create(AOwner: TComponent);
  1339. begin
  1340.   inherited;
  1341.   FIncrement := 8;
  1342. end;
  1343.  
  1344. function TCustomRangeBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  1345.   {$IFDEF CLX}const{$ENDIF} MousePos: TPoint): Boolean;
  1346. begin
  1347.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  1348.   if not Result then Position := Position + Increment * WheelDelta / 120;
  1349.   Result := True;
  1350. end;
  1351.  
  1352. function TCustomRangeBar.DrawEnabled: Boolean;
  1353. begin
  1354.   Result := Enabled and (Range > EffectiveWindow);
  1355. end;
  1356.  
  1357. function TCustomRangeBar.GetHandleRect: TRect;
  1358. var
  1359.   BtnSz, ClientSz: Integer;
  1360.   HandleSz, HandlePos: Integer;
  1361.   R: TRect;
  1362.   Horz: Boolean;
  1363. begin
  1364.   R := Rect(0, 0, ClientWidth, ClientHeight);
  1365.   Horz := Kind = sbHorizontal;
  1366.   BtnSz := GetButtonSize;
  1367.   if Horz then
  1368.   begin
  1369.     InflateRect(R, -BtnSz, 0);
  1370.     ClientSz := R.Right - R.Left;
  1371.   end
  1372.   else
  1373.   begin
  1374.     InflateRect(R, 0, -BtnSz);
  1375.     ClientSz := R.Bottom - R.Top;
  1376.   end;
  1377.   if ClientSz < 18 then
  1378.   begin
  1379.     Result := Rect(0, 0, 0, 0);
  1380.     Exit;
  1381.   end;
  1382.  
  1383.   if Range > EffectiveWindow then
  1384.   begin
  1385.     HandleSz := Round(ClientSz * EffectiveWindow / Range);
  1386.     if HandleSz >= MIN_SIZE then HandlePos := Round(ClientSz * Position / Range)
  1387.     else
  1388.     begin
  1389.       HandleSz := MIN_SIZE;
  1390.       HandlePos := Round((ClientSz - MIN_SIZE) * Position / (Range - EffectiveWindow));
  1391.     end;
  1392.     Result := R;
  1393.     if Horz then
  1394.     begin
  1395.       Result.Left := R.Left + HandlePos;
  1396.       Result.Right := R.Left + HandlePos + HandleSz;
  1397.     end
  1398.     else
  1399.     begin
  1400.       Result.Top := R.Top + HandlePos;
  1401.       Result.Bottom := R.Top + HandlePos + HandleSz;
  1402.     end;
  1403.   end
  1404.   else Result := R;
  1405. end;
  1406.  
  1407. function TCustomRangeBar.IsPositionStored: Boolean;
  1408. begin
  1409.   Result := FPosition > 0;
  1410. end;
  1411.  
  1412. procedure TCustomRangeBar.MouseDown(Button: TMouseButton;
  1413.   Shift: TShiftState; X, Y: Integer);
  1414. begin
  1415.   if Range <= EffectiveWindow then DragZone := zNone
  1416.   else
  1417.   begin
  1418.     inherited;
  1419.     if DragZone = zHandle then
  1420.     begin
  1421.       StopDragTracking;
  1422.       PosBeforeDrag := Position;
  1423.     end;
  1424.   end;
  1425. end;
  1426.  
  1427. procedure TCustomRangeBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  1428. var
  1429.   Delta: Single;
  1430.   WinSz: Single;
  1431.   ClientSz, HandleSz: Integer;
  1432. begin
  1433.   inherited;
  1434.   if DragZone = zHandle then
  1435.   begin
  1436.     WinSz := EffectiveWindow;
  1437.  
  1438.     if Range <= WinSz then Exit;
  1439.     if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;
  1440.  
  1441.     if Kind = sbHorizontal then ClientSz := ClientWidth  else ClientSz := ClientHeight;
  1442.     Dec(ClientSz, GetButtonSize * 2);
  1443.     if BorderStyle = bsSingle then Dec(ClientSz, 2);
  1444.     HandleSz := Round(ClientSz * WinSz / Range);
  1445.  
  1446.     if HandleSz < MIN_SIZE then Delta := Round(Delta * (Range - WinSz) / (ClientSz - MIN_SIZE))
  1447.     else Delta := Delta * Range / ClientSz;
  1448.  
  1449.     GenChange := True;
  1450.     Position := PosBeforeDrag + Delta;
  1451.     GenChange := False;
  1452.   end;
  1453. end;
  1454.  
  1455. procedure TCustomRangeBar.Resize;
  1456. var
  1457.   OldWindow: Integer;
  1458.   Center: Single;
  1459. begin
  1460.   if Centered then
  1461.   begin
  1462.     OldWindow := EffectiveWindow;
  1463.     UpdateEffectiveWindow;
  1464.     if Range > EffectiveWindow then
  1465.     begin
  1466.       if Range > OldWindow then Center := (FPosition + OldWindow * 0.5) / Range
  1467.       else Center := 0.5;
  1468.       FPosition := Center * Range - EffectiveWindow * 0.5;
  1469.     end;
  1470.   end;
  1471.   AdjustPosition;
  1472.   inherited;
  1473. end;
  1474.  
  1475. procedure TCustomRangeBar.SetParams(NewRange, NewWindow: Integer);
  1476. var
  1477.   OldWindow, OldRange: Integer;
  1478.   Center: Single;
  1479. begin
  1480.   if NewRange < 0 then NewRange := 0;
  1481.   if NewWindow < 0 then NewWindow := 0;
  1482.   if (NewRange <> FRange) or (NewWindow <> EffectiveWindow) then
  1483.   begin
  1484.     OldWindow := EffectiveWindow;
  1485.     OldRange := Range;
  1486.     FRange := NewRange;
  1487.     FWindow := NewWindow;
  1488.     UpdateEffectiveWindow;
  1489.     if Centered and (Range > EffectiveWindow) then
  1490.     begin
  1491.       if (OldRange > OldWindow) and (OldRange <> 0) then
  1492.         Center := (FPosition + OldWindow * 0.5) / OldRange
  1493.       else
  1494.         Center := 0.5;
  1495.       FPosition := Center * Range - EffectiveWindow * 0.5;
  1496.     end;
  1497.     AdjustPosition;
  1498.     Invalidate;
  1499.   end;
  1500. end;
  1501.  
  1502. procedure TCustomRangeBar.SetPosition(Value: Single);
  1503. var
  1504.   OldPosition: Single;
  1505. begin
  1506.   if Value <> FPosition then
  1507.   begin
  1508.     OldPosition := FPosition;
  1509.     FPosition := Value;
  1510.     AdjustPosition;
  1511.     if OldPosition <> FPosition then
  1512.     begin
  1513.       Invalidate;
  1514.       DoChange;
  1515.     end;
  1516.   end;
  1517. end;
  1518.  
  1519. procedure TCustomRangeBar.SetRange(Value: Integer);
  1520. begin
  1521.   SetParams(Value, Window);
  1522. end;
  1523.  
  1524. procedure TCustomRangeBar.SetWindow(Value: Integer);
  1525. begin
  1526.   SetParams(Range, Value);
  1527. end;
  1528.  
  1529. procedure TCustomRangeBar.TimerHandler(Sender: TObject);
  1530. var
  1531.   OldPosition: Single;
  1532.   Pt: TPoint;
  1533.  
  1534.   function MousePos: TPoint;
  1535.   begin
  1536.     Result := ScreenToClient(Mouse.CursorPos);
  1537.     if Result.X < 0 then Result.X := 0;
  1538.     if Result.Y < 0 then Result.Y := 0;
  1539.     if Result.X >= ClientWidth then Result.X := ClientWidth - 1;
  1540.     if Result.Y >= ClientHeight then Result.Y := ClientHeight - 1
  1541.   end;
  1542.  
  1543. begin
  1544.   inherited;
  1545.   GenChange := True;
  1546.   OldPosition := Position;
  1547.  
  1548.   case DragZone of
  1549.     zBtnPrev:
  1550.       begin
  1551.         Position := Position - Increment;
  1552.         if Position = OldPosition then StopDragTracking;
  1553.       end;
  1554.  
  1555.     zBtnNext:
  1556.       begin
  1557.         Position := Position + Increment;
  1558.         if Position = OldPosition then StopDragTracking;
  1559.       end;
  1560.  
  1561.     zTrackNext:
  1562.       begin
  1563.         Pt := MousePos;
  1564.         if GetZone(Pt.X, Pt.Y) in [zTrackNext, zBtnNext] then
  1565.         Position := Position + EffectiveWindow;
  1566.       end;
  1567.  
  1568.     zTrackPrev:
  1569.       begin
  1570.         Pt := MousePos;
  1571.         if GetZone(Pt.X, Pt.Y) in [zTrackPrev, zBtnPrev] then
  1572.         Position := Position - EffectiveWindow;
  1573.       end;
  1574.   end;
  1575.   GenChange := False;
  1576. end;
  1577.  
  1578. procedure TCustomRangeBar.UpdateEffectiveWindow;
  1579. begin
  1580.   if FWindow > 0 then FEffectiveWindow := FWindow
  1581.   else
  1582.   begin
  1583.     if Kind = sbHorizontal then FEffectiveWindow := Width
  1584.     else FEffectiveWindow := Height;
  1585.   end;
  1586. end;
  1587.  
  1588. //----------------------------------------------------------------------------//
  1589.  
  1590. { TCustomGaugeBar }
  1591.  
  1592. procedure TCustomGaugeBar.AdjustPosition;
  1593. begin
  1594.   if Position < Min then Position := Min
  1595.   else if Position > Max then Position := Max;
  1596. end;
  1597.  
  1598. constructor TCustomGaugeBar.Create(AOwner: TComponent);
  1599. begin
  1600.   inherited;
  1601.   FLargeChange := 1;
  1602.   FMax := 100;
  1603.   FSmallChange := 1;
  1604. end;
  1605.  
  1606. function TCustomGaugeBar.DoMouseWheel(Shift: TShiftState;
  1607.   WheelDelta: Integer; {$IFDEF CLX}const{$ENDIF} MousePos: TPoint): Boolean;
  1608. begin
  1609.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  1610.   if not Result then Position := Position + FSmallChange * WheelDelta div 120;
  1611.   Result := True;
  1612. end;
  1613.  
  1614. function TCustomGaugeBar.GetHandleRect: TRect;
  1615. var
  1616.   Sz, HandleSz: Integer;
  1617.   Horz: Boolean;
  1618.   Pos: Integer;
  1619. begin
  1620.   Result := GetTrackBoundary;
  1621.   Horz := Kind = sbHorizontal;
  1622.   HandleSz := GetHandleSize;
  1623.  
  1624.   if Horz then Sz := Result.Right - Result.Left
  1625.   else Sz := Result.Bottom - Result.Top;
  1626.  
  1627.  
  1628.   Pos := Round((Position - Min) * (Sz - GetHandleSize) / (Max - Min));
  1629.  
  1630.   if Horz then
  1631.   begin
  1632.     Inc(Result.Left, Pos);
  1633.     Result.Right := Result.Left + HandleSz;
  1634.   end
  1635.   else
  1636.   begin
  1637.     Inc(Result.Top, Pos);
  1638.     Result.Bottom := Result.Top + HandleSz;
  1639.   end;
  1640. end;
  1641.  
  1642. function TCustomGaugeBar.GetHandleSize: Integer;
  1643. var
  1644.   R: TRect;
  1645.   Sz: Integer;
  1646. begin
  1647.   Result := HandleSize;
  1648.   if Result = 0 then
  1649.   begin
  1650.     if Kind = sbHorizontal then Result := ClientHeight else Result := ClientWidth;
  1651.   end;
  1652.   R := GetTrackBoundary;
  1653.   if Kind = sbHorizontal then Sz := R.Right - R.Left
  1654.   else Sz := R.Bottom - R.Top;
  1655.   if Sz - Result < 1 then Result := Sz - 1;
  1656.   if Result < 0 then Result := 0;
  1657. end;
  1658.  
  1659. procedure TCustomGaugeBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1660. begin
  1661.   inherited;
  1662.   if DragZone = zHandle then
  1663.   begin
  1664.     StopDragTracking;
  1665.     PosBeforeDrag := Position;
  1666.   end;
  1667. end;
  1668.  
  1669. procedure TCustomGaugeBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  1670. var
  1671.   Delta: Single;
  1672.   R: TRect;
  1673.   ClientSz: Integer;
  1674. begin
  1675.   inherited;
  1676.   if DragZone = zHandle then
  1677.   begin
  1678.     if Kind = sbHorizontal then Delta := X - StoredX else Delta := Y - StoredY;
  1679.     R := GetTrackBoundary;
  1680.  
  1681.     if Kind = sbHorizontal then ClientSz := R.Right - R.Left
  1682.     else ClientSz := R.Bottom - R.Top;
  1683.  
  1684.     Delta := Delta * (Max - Min) / (ClientSz - GetHandleSize);
  1685.  
  1686.     GenChange := True;
  1687.     Position := Round(PosBeforeDrag + Delta);
  1688.     GenChange := False;
  1689.   end;
  1690. end;
  1691.  
  1692. procedure TCustomGaugeBar.SetHandleSize(Value: Integer);
  1693. begin
  1694.   if Value < 0 then Value := 0;
  1695.   if Value <> FHandleSize then
  1696.   begin
  1697.     FHandleSize := Value;
  1698.     Invalidate;
  1699.   end;
  1700. end;
  1701.  
  1702. procedure TCustomGaugeBar.SetLargeChange(Value: Integer);
  1703. begin
  1704.   if Value < 1 then Value := 1;
  1705.   FLargeChange := Value;
  1706. end;
  1707.  
  1708. procedure TCustomGaugeBar.SetMax(Value: Integer);
  1709. begin
  1710.   if (Value <= FMin) and not (csLoading in ComponentState) then Value := FMin + 1;
  1711.   if Value <> FMax then
  1712.   begin
  1713.     FMax := Value;
  1714.     AdjustPosition;
  1715.     Invalidate;
  1716.   end;
  1717. end;
  1718.  
  1719. procedure TCustomGaugeBar.SetMin(Value: Integer);
  1720. begin
  1721.   if (Value >= FMax) and not (csLoading in ComponentState) then Value := FMax - 1;
  1722.   if Value <> FMin then
  1723.   begin
  1724.     FMin := Value;
  1725.     AdjustPosition;
  1726.     Invalidate;
  1727.   end;
  1728. end;
  1729.  
  1730. procedure TCustomGaugeBar.SetPosition(Value: Integer);
  1731. begin
  1732.   if Value < Min then Value := Min
  1733.   else if Value > Max then Value := Max;
  1734.   if Round(FPosition) <> Value then
  1735.   begin
  1736.     FPosition := Value;
  1737.     Invalidate;
  1738.     DoChange;
  1739.   end;
  1740. end;
  1741.  
  1742. procedure TCustomGaugeBar.SetSmallChange(Value: Integer);
  1743. begin
  1744.   if Value < 1 then Value := 1;
  1745.   FSmallChange := Value;
  1746. end;
  1747.  
  1748. procedure TCustomGaugeBar.TimerHandler(Sender: TObject);
  1749. var
  1750.   OldPosition: Single;
  1751.   Pt: TPoint;
  1752.  
  1753.   function MousePos: TPoint;
  1754.   begin
  1755.     Result := ScreenToClient(Mouse.CursorPos);
  1756.     if Result.X < 0 then Result.X := 0;
  1757.     if Result.Y < 0 then Result.Y := 0;
  1758.     if Result.X >= ClientWidth then Result.X := ClientWidth - 1;
  1759.     if Result.Y >= ClientHeight then Result.Y := ClientHeight - 1
  1760.   end;
  1761.  
  1762. begin
  1763.   inherited;
  1764.   GenChange := True;
  1765.   OldPosition := Position;
  1766.  
  1767.   case DragZone of
  1768.     zBtnPrev:
  1769.       begin
  1770.         Position := Position - SmallChange;
  1771.         if Position = OldPosition then StopDragTracking;
  1772.       end;
  1773.  
  1774.     zBtnNext:
  1775.       begin
  1776.         Position := Position + SmallChange;
  1777.         if Position = OldPosition then StopDragTracking;
  1778.       end;
  1779.  
  1780.     zTrackNext:
  1781.       begin
  1782.         Pt := MousePos;
  1783.         if GetZone(Pt.X, Pt.Y) in [zTrackNext, zBtnNext] then
  1784.         Position := Position + LargeChange;
  1785.       end;
  1786.  
  1787.     zTrackPrev:
  1788.       begin
  1789.         Pt := MousePos;
  1790.         if GetZone(Pt.X, Pt.Y) in [zTrackPrev, zBtnPrev] then
  1791.         Position := Position - LargeChange;
  1792.       end;
  1793.   end;
  1794.   GenChange := False;
  1795. end;
  1796.  
  1797. { TArrowBarAccess }
  1798.  
  1799. function TArrowBarAccess.GetBackgnd: TRBBackgnd;
  1800. begin
  1801.   Result := FMaster.Backgnd;
  1802. end;
  1803.  
  1804. function TArrowBarAccess.GetButtonSize: Integer;
  1805. begin
  1806.   Result := FMaster.ButtonSize;
  1807. end;
  1808.  
  1809. function TArrowBarAccess.GetColor: TColor;
  1810. begin
  1811.   Result := FMaster.Color;
  1812. end;
  1813.  
  1814. function TArrowBarAccess.GetHandleColor: TColor;
  1815. begin
  1816.   Result := FMaster.HandleColor;
  1817. end;
  1818.  
  1819. function TArrowBarAccess.GetHighLightColor: TColor;
  1820. begin
  1821.   Result := FMaster.HighLightColor;
  1822. end;
  1823.  
  1824. function TArrowBarAccess.GetShadowColor: TColor;
  1825. begin
  1826.   Result := FMaster.ShadowColor;
  1827. end;
  1828.  
  1829. function TArrowBarAccess.GetButtonColor: TColor;
  1830. begin
  1831.   Result := FMaster.ButtonColor;
  1832. end;
  1833.  
  1834. function TArrowBarAccess.GetBorderColor: TColor;
  1835. begin
  1836.   Result := FMaster.BorderColor;
  1837. end;
  1838.  
  1839. function TArrowBarAccess.GetShowArrows: Boolean;
  1840. begin
  1841.   Result := FMaster.ShowArrows;
  1842. end;
  1843.  
  1844. function TArrowBarAccess.GetShowHandleGrip: Boolean;
  1845. begin
  1846.   Result := FMaster.ShowHandleGrip;
  1847. end;
  1848.  
  1849. function TArrowBarAccess.GetStyle: TRBStyle;
  1850. begin
  1851.   Result := FMaster.Style;
  1852. end;
  1853.  
  1854. procedure TArrowBarAccess.SetBackgnd(Value: TRBBackgnd);
  1855. begin
  1856.   FMaster.Backgnd := Value;
  1857.   if FSlave <> nil then FSlave.Backgnd := Value;
  1858. end;
  1859.  
  1860. procedure TArrowBarAccess.SetButtonSize(Value: Integer);
  1861. begin
  1862.   FMaster.ButtonSize := Value;
  1863.   if FSlave <> nil then FSlave.ButtonSize := Value;
  1864. end;
  1865.  
  1866. procedure TArrowBarAccess.SetColor(Value: TColor);
  1867. begin
  1868.   FMaster.Color := Value;
  1869.   if FSlave <> nil then FSlave.Color := Value;
  1870. end;
  1871.  
  1872. procedure TArrowBarAccess.SetHandleColor(Value: TColor);
  1873. begin
  1874.   FMaster.HandleColor := Value;
  1875.   if FSlave <> nil then FSlave.HandleColor := Value;
  1876. end;
  1877.  
  1878. procedure TArrowBarAccess.SetHighLightColor(Value: TColor);
  1879. begin
  1880.   FMaster.HighLightColor := Value;
  1881.   if FSlave <> nil then FSlave.HighLightColor := Value;
  1882. end;
  1883.  
  1884. procedure TArrowBarAccess.SetShadowColor(Value: TColor);
  1885. begin
  1886.   FMaster.ShadowColor := Value;
  1887.   if FSlave <> nil then FSlave.ShadowColor := Value;
  1888. end;
  1889.  
  1890. procedure TArrowBarAccess.SetButtonColor(Value: TColor);
  1891. begin
  1892.   FMaster.ButtonColor := Value;
  1893.   if FSlave <> nil then FSlave.ButtonColor := Value;
  1894. end;
  1895.  
  1896. procedure TArrowBarAccess.SetBorderColor(Value: TColor);
  1897. begin
  1898.   FMaster.BorderColor := Value;
  1899.   if FSlave <> nil then FSlave.BorderColor := Value;
  1900. end;
  1901.  
  1902. procedure TArrowBarAccess.SetShowArrows(Value: Boolean);
  1903. begin
  1904.   FMaster.ShowArrows := Value;
  1905.   if FSlave <> nil then FSlave.ShowArrows := Value;
  1906. end;
  1907.  
  1908. procedure TArrowBarAccess.SetShowHandleGrip(Value: Boolean);
  1909. begin
  1910.   FMaster.ShowHandleGrip := Value;
  1911.   if FSlave <> nil then FSlave.ShowHandleGrip := Value;
  1912. end;
  1913.  
  1914. procedure TArrowBarAccess.SetStyle(Value: TRBStyle);
  1915. begin
  1916.   FMaster.Style := Value;
  1917.   if FSlave <> nil then FSlave.Style := Value;
  1918. end;
  1919.  
  1920. end.
  1921.  
  1922.