home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d123456 / SRVALEDT.ZIP / SRValEdt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-16  |  85.0 KB  |  2,932 lines
  1. unit SRValEdt;
  2.  
  3. { TSRValueEdit (C)opyright 2001 Version 1.00
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Die Komponente TSRValueEdit ist eine Kombination aus
  9.   einem Drehknopf fⁿr die optische Anzeige des eingestellten
  10.   Wertes und zwei weiteren Komponenten zur Einstellung des Wertes:
  11.  
  12.   - Einer TNumericEdit-Komponente fⁿr die alphanumerische
  13.     Eingabe eines Zahlenwerts. Zahlenwerte k÷nnen direkt eingetippt
  14.     werden oder man kann ⁿber SpinButtons einzelne Stellen Σndern.
  15.  
  16.   - Einer TSliderEdit-Komponente fⁿr die Einstellung eines
  17.     Zahlenwerts mit der Maus. Dazu wird einfach ein Schiebesteller
  18.     an die gewⁿnschte Position gezogen.
  19.  
  20.   ZusΣtzlich werden die letzten vier eingestellten Werte gespeichert
  21.   und k÷nnen ⁿber ein Popup-Menⁿ wieder abgerufen werden. Auf diese
  22.   Weise stellt sie den optimalen Kompromiss zwischen minimalem
  23.   Platzbedarf und optimaler Bedienbarkeit mit Maus und Tastatur zur
  24.   Auswahl eines Zahlenwertes dar. 
  25.  
  26.   Die Komponenten sind Public Domain, das Urheberrecht liegt aber
  27.   beim Autor. }
  28.  
  29.  
  30. interface
  31.  
  32. {$I SRDefine.inc}
  33.  
  34. uses
  35.   {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  36.   SysUtils, Messages, Classes, Graphics, Controls, StdCtrls, ExtCtrls,
  37.   Forms, Menus;
  38.  
  39. type
  40.   TNESpinBtnClick  = Procedure (Sender: TObject; BtnIndex: integer; UpBtn: boolean) of object;
  41.   TNumDigits       = 1..20;
  42.   TScrewSize       = 5..15;
  43.   TRulerDirection  = (rdHorizontal, rdVertical);
  44.   TTickStyle       = (tsNone, tsMinMax, tsAll);
  45.   TTriangleDest    = (tdTop, tdRight, tdBottom, tdLeft);
  46.  
  47.  
  48.   TColors = class(TPersistent)
  49.   private
  50.     FBackground,
  51.     FBorderHL,
  52.     FBorderSh,
  53.     FNumBackground,
  54.     FNumFrame,
  55.     FRuler,
  56.     FSliderBorder,
  57.     FSliderTop,
  58.     FSliderMark,
  59.     FTickMarks        : TColor;
  60.     FOwner            : TCustomControl;
  61.  
  62.     procedure AssignBevelColors(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;HLContrast,ShContrast:integer);
  63.     procedure SetBackground(NewValue: TColor);
  64.     procedure SetNumBackground(NewValue: TColor);
  65.     procedure SetNumFrame(NewValue: TColor);
  66.     procedure SetRuler(NewValue: TColor);
  67.     procedure SetSliderBorder(NewValue: TColor);
  68.     procedure SetSliderMark(NewValue: TColor);
  69.     procedure SetSliderTop(NewValue: TColor);
  70.     procedure SetTickMarks(NewValue: TColor);
  71.  
  72.   public
  73.     constructor Create(AOwner: TComponent);
  74.     procedure Assign(Source : TPersistent); override;
  75.  
  76.   published
  77.     property Background: TColor read FBackground write SetBackground;
  78.     property NumBackground: TColor read FNumBackground write SetNumBackground;
  79.     property NumFrame: TColor read FNumFrame write SetNumFrame;
  80.     property Ruler: TColor read FRuler write SetRuler;
  81.     property SliderBorder: TColor read FSliderBorder write SetSliderBorder;
  82.     property SliderTop: TColor read FSliderTop write SetSliderTop;
  83.     property SliderMark: TColor read FSliderMark write SetSliderMark;
  84.     property TickMarks: TColor read FTickMarks write SetTickMarks;
  85.  
  86.   end;
  87.  
  88.   TSRValueEdit = class;
  89.  
  90.   TNumericEdit = class(TCustomControl)
  91.   private
  92.     FAutoSize         : boolean;
  93.     FBtnHeight        : integer;
  94.     FDrawBuffer       : TBitmap;
  95.     FColor            : TColor;
  96.     FDecSeparator     : char;
  97.     FDecSeparatorPos  : byte;
  98.     FDigitWidth,
  99.     FDownIdxTop,
  100.     FDownIdxBtm       : integer;
  101.     FEditPos          : byte;
  102.     FFrameColor       : TColor;
  103.     FHasFocus         : boolean;
  104.     FMinValue,
  105.     FMaxValue         : extended;
  106.     FNumDigits        : TNumDigits;
  107.     FValue            : extended;
  108.     FValueEdit        : TSRValueEdit;
  109.     FOnChange         : TNotifyEvent;
  110.     FOnSpinBtnClick   : TNESpinBtnClick;
  111.  
  112.     procedure CalcControlHeight;
  113.     procedure CalcDigitWidth;
  114.     function GetMaxValue:extended;
  115.     procedure IncreaseDigitValue(DigitIndex:byte;Increment:integer);
  116.     procedure SetAutoSize(newValue: boolean);
  117.     procedure SetBtnHeight(newValue: integer);
  118.     procedure SetColor(newValue: TColor);
  119.     procedure SetDecSeparator(newValue: char);
  120.     procedure SetDecSeparatorPos(newValue: byte);
  121.     procedure SetDigitValue(DigitIndex:byte;Value:byte);
  122.     procedure SetEditPos(newValue: byte);
  123.     procedure SetFrameColor(newValue: TColor);
  124.     procedure SetMaxValue(newValue: extended);
  125.     procedure SetMinValue(newValue: extended);
  126.     procedure SetNumDigits(newValue: TNumDigits);
  127.     procedure SetValue(newValue: extended);
  128.     procedure SpinButtonDown(ButtonIndex:integer;SpinUp:boolean);
  129.     procedure SpinButtonUp(ButtonIndex:integer;SpinUp:boolean);
  130.  
  131.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  132.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  133.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd;
  134.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  135.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  136.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  137.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  138.  
  139.   protected
  140.     procedure Change; dynamic;
  141.     procedure DoSpinBtnClick(BtnIndex:integer;UpBtn:boolean);
  142.     procedure DrawDigit(ACanvas:TCanvas;ARect:TRect;AValue:byte;Editing:boolean);
  143.     function GetDigitValue(DigitIndex:byte):byte;
  144.     function GetSpinButtonIndex(X,Y:integer;var UpperRow:boolean):integer;
  145.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  146.     procedure KeyPress(var Key: Char); override;
  147.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  148.     procedure Loaded; override;
  149.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  150.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  151.     procedure Paint; override;
  152.  
  153.   public
  154.     constructor Create(AOwner: TComponent); override;
  155.     destructor Destroy; override;
  156.  
  157.   published
  158.     property Align;
  159.     {$IFDEF SR_Delphi5_Up}
  160.     property Anchors;
  161.     {$ENDIF}
  162.     property AutoSize: boolean read FAutoSize write SetAutoSize;
  163.     property BtnHeight: integer read FBtnHeight write SetBtnHeight;
  164.     property Color: TColor read FColor write SetColor;
  165.     {$IFDEF SR_Delphi5_Up}
  166.     property Constraints;
  167.     {$ENDIF}
  168.     property Ctl3D;
  169.     property DecSeparator: char read FDecSeparator write SetDecSeparator;
  170.     property DecSeparatorPos: byte read FDecSeparatorPos write SetDecSeparatorPos;
  171.     property DragCursor;
  172.     {$IFDEF SR_Delphi5_Up}
  173.     property DragKind;
  174.     {$ENDIF}
  175.     property DragMode;
  176.     property EditPos: byte read FEditPos write SetEditPos;
  177.     property Enabled;
  178.     property Font;
  179.     property FrameColor: TColor read FFrameColor write SetFrameColor;
  180.     property MaxValue: extended read FMaxValue write SetMaxValue;
  181.     property MinValue: extended read FMinValue write SetMinValue;
  182.     property NumDigits: TNumDigits read FNumDigits write SetNumDigits;
  183.     property ParentCtl3D;
  184.     property ParentShowHint;
  185.     property PopupMenu;
  186.     property ShowHint;
  187.     property TabOrder;
  188.     property TabStop;
  189.     property Value: extended read FValue write SetValue;
  190.     property Visible;
  191.  
  192.     {$IFDEF SR_Delphi5_Up}
  193.     property OnCanResize;
  194.     {$ENDIF}
  195.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  196.     {$IFDEF SR_Delphi5_Up}
  197.     property OnConstrainedResize;
  198.     property OnContextPopup;
  199.     {$ENDIF}
  200.     property OnDblClick;
  201.     property OnDragDrop;
  202.     property OnDragOver;
  203.     property OnEndDrag;
  204.     property OnEnter;
  205.     property OnExit;
  206.     property OnKeyDown;
  207.     property OnKeyPress;
  208.     property OnKeyUp;
  209.     property OnMouseDown;
  210.     property OnMouseMove;
  211.     property OnMouseUp;
  212.     {$IFDEF SR_Delphi4_Up}
  213.     property OnResize;
  214.     {$ENDIF}
  215.     property OnSpinBtnClick: TNESpinBtnClick read FOnSpinBtnClick write FOnSpinBtnClick;
  216.     {$IFDEF SR_Delphi2_Up}
  217.     property OnStartDrag;
  218.     {$ENDIF}
  219.   end;
  220.  
  221.  
  222.   TSliderEdit = class(TCustomControl)
  223.   private
  224.     FAutoHide         : boolean;
  225.     FBevelStyle       : TPanelBevel;
  226.     FBevelWidth,
  227.     FBorderWidth      : integer;
  228.     FColors           : TColors;
  229.     FDisplayHeight,
  230.     FDisplayWidth,
  231.     FDownIndex        : integer;
  232.     FDrawBuffer       : TBitmap;
  233.     FFocusRect,
  234.     FHasFocus         : boolean;
  235.     FMaxValue,
  236.     FMinValue         : integer;
  237.     FMouseDown        : boolean;
  238.     FRulerDirection   : TRulerDirection;
  239.     FSliderWidth,
  240.     FSpinBtnHeight    : integer;
  241.     FTickStyle        : TTickStyle;
  242.     FValue            : integer;
  243.     FValueEdit        : TSRValueEdit;
  244.     FOnChange         : TNotifyEvent;
  245.  
  246.     procedure SetBevelStyle(newValue: TPanelBevel);
  247.     procedure SetBevelWidth(newValue: integer);
  248.     procedure SetBorderWidth(newValue: integer);
  249.     procedure SetColors(newValue: TColors);
  250.     procedure SetDisplayWidth(newValue: integer);
  251.     procedure SetFocusRect(newValue: boolean);
  252.     procedure SetMaxValue(newValue: integer);
  253.     procedure SetMinValue(newValue: integer);
  254.     procedure SetRulerDirection(newValue: TRulerDirection);
  255.     procedure SetSliderWidth(newValue: integer);
  256.     procedure SetSpinBtnHeight(newValue: integer);
  257.     procedure SetTickStyle(newValue: TTickStyle);
  258.     procedure SetValue(newValue: integer);
  259.  
  260.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  261.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd;
  262.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  263.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  264.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  265.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  266.  
  267.   protected
  268.     procedure CalcDisplayHeight;
  269.     procedure DoDrawFocusRect(ACanvas:TCanvas);
  270.     procedure DoSpinBtnClick(const UpBtn:boolean;Shift:TShiftState);
  271.     procedure DrawValueDisplay(ACanvas:TCanvas;ARect:TRect);
  272.     procedure DrawResetButtons(ACanvas:TCanvas;ARect:TRect);
  273.     procedure DrawRuler(ACanvas:TCanvas;ARect:TRect;DrawFocus:boolean);
  274.     function GetRulerLength:integer;
  275.     function GetSliderOffset(const AValue:integer):integer;
  276.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  277.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  278.     procedure Loaded; override;
  279.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  280.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  281.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  282.     procedure Paint; override;
  283.  
  284.   public
  285.     constructor Create(AOwner: TComponent); override;
  286.     destructor Destroy; override;
  287.  
  288.     property ValueEdit: TSRValueEdit read FValueEdit write FValueEdit;
  289.  
  290.   published
  291.     property Align;
  292.     {$IFDEF SR_Delphi5_Up}
  293.     property Anchors;
  294.     {$ENDIF}
  295.     property BevelStyle: TPanelBevel read FBevelStyle write SetBevelStyle;
  296.     property BevelWidth: integer read FBevelWidth write SetBevelWidth;
  297.     property BorderWidth: integer read FBorderWidth write SetBorderWidth;
  298.     property Colors: TColors read FColors write SetColors;
  299.     {$IFDEF SR_Delphi5_Up}
  300.     property Constraints;
  301.     {$ENDIF}
  302.     property Ctl3D;
  303.     property DisplayWidth: integer read FDisplayWidth write SetDisplayWidth;
  304.     property DragCursor;
  305.     {$IFDEF SR_Delphi5_Up}
  306.     property DragKind;
  307.     {$ENDIF}
  308.     property DragMode;
  309.     property Enabled;
  310.     property FocusRect: boolean read FFocusRect write SetFocusRect;
  311.     property Font;
  312.     property MaxValue: integer read FMaxValue write SetMaxValue;
  313.     property MinValue: integer read FMinValue write SetMinValue;
  314.     property ParentCtl3D;
  315.     property ParentShowHint;
  316.     property PopupMenu;
  317.     property ShowHint;
  318.     property RulerDirection: TRulerDirection read FRulerDirection write SetRulerDirection;
  319.     property SliderWidth: integer read FSliderWidth write SetSliderWidth;
  320.     property SpinBtnHeight: integer read FSpinBtnHeight write SetSpinBtnHeight;
  321.     property TabOrder;
  322.     property TabStop;
  323.     property TickStyle : TTickStyle read FTickStyle write SetTickStyle;
  324.     property Value: integer read FValue write SetValue;
  325.     property Visible;
  326.  
  327.     {$IFDEF SR_Delphi5_Up}
  328.     property OnCanResize;
  329.     {$ENDIF}
  330.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  331.     {$IFDEF SR_Delphi5_Up}
  332.     property OnConstrainedResize;
  333.     property OnContextPopup;
  334.     {$ENDIF}
  335.     property OnDblClick;
  336.     property OnDragDrop;
  337.     property OnDragOver;
  338.     property OnEndDrag;
  339.     property OnEnter;
  340.     property OnExit;
  341.     property OnKeyDown;
  342.     property OnKeyPress;
  343.     property OnKeyUp;
  344.     property OnMouseDown;
  345.     property OnMouseMove;
  346.     property OnMouseUp;
  347.     {$IFDEF SR_Delphi4_Up}
  348.     property OnResize;
  349.     {$ENDIF}
  350.     {$IFDEF SR_Delphi2_Up}
  351.     property OnStartDrag;
  352.     {$ENDIF}
  353.  
  354.   end;
  355.  
  356.  
  357.   TSRValueEdit = class(TCustomControl)
  358.   private
  359.     FBevelStyle       : TPanelBevel;
  360.     FBevelWidth,
  361.     FBorderWidth      : integer;
  362.     FCaptureMouse     : boolean;
  363.     FColors           : TColors;
  364.     FDecSeparator     : char;
  365.     FDecSeparatorPos  : byte;
  366.     FFocusRect        : boolean;
  367.     FHistoryCount     : byte;
  368.     FHistoryMenu      : TPopupMenu;
  369.     FHistoryValue     : array [0..3] of extended;
  370.     FNumDigits        : TNumDigits;
  371.     FNumericEdit      : TNumericEdit;
  372.     FMaxValue,
  373.     FMinValue         : extended;
  374.     FNumEditOffset,
  375.     FOldOffset        : integer;
  376.     FOldvalue         : extended;
  377.     FSliderWidth      : integer;
  378.     FScrewPos         : array [0..4] of byte;
  379.     FScrewSize        : TScrewSize;
  380.     FShowScrews       : boolean;
  381.     FSliderEdit       : TSliderEdit;
  382.     FSliderEditLength,
  383.     FSliderEditWidth  : integer;
  384.     FRulerDirection   : TRulerDirection;
  385.     FSpinBtnHeight,
  386.     FSpinControlWidth : integer;
  387.     FTickStyle        : TTickStyle;
  388.     FValue            : extended;
  389.     FValueHistory     : boolean;
  390.     FOnChange,
  391.     FOnHideSlider,
  392.     FOnHistoryClick,
  393.     FOnShowSlider     : TNotifyEvent;
  394.     FOnSpinBtnClick   : TNESpinBtnClick;
  395.  
  396.     procedure DestroySliderEdit;
  397.     procedure SetBevelStyle(newValue: TPanelBevel);
  398.     procedure SetBevelWidth(newValue: integer);
  399.     procedure SetBorderWidth(newValue: integer);
  400.     procedure SetColors(newValue: TColors);
  401.     procedure SetDecSeparator(newValue: char);
  402.     procedure SetDecSeparatorPos(newValue: byte);
  403.     procedure SetFocusRect(newValue: boolean);
  404.     procedure SetMaxValue(newValue: extended);
  405.     procedure SetMinValue(newValue: extended);
  406.     procedure SetNumDigits(newValue: TNumDigits);
  407.     procedure SetControlsPosAndWidth;
  408.     procedure SetRulerDirection(newValue: TRulerDirection);
  409.     procedure SetSliderEditWidth(newValue: integer);
  410.     procedure SetSpinBtnHeight(newValue: integer);
  411.     procedure SetSpinControlWidth(newValue: integer);
  412.     procedure SetScrewSize(newValue: TScrewSize);
  413.     procedure SetShowScrews(newValue: boolean);
  414.     procedure SetTickStyle(newValue: TTickStyle);
  415.     procedure SetValue(newValue: extended);
  416.  
  417.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  418.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  419.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  420.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  421.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  422.  
  423.   protected
  424.     procedure AddHistoryItem(ValueNr:byte);
  425.     procedure AddValueToHistory(AValue:extended);
  426.     procedure CalcBorderWidth;
  427.     procedure Change; dynamic;
  428.     procedure DoDrawFocusRect(IsFocused:boolean); dynamic;
  429.     procedure DoSpinBtnClick(BtnIndex:integer;UpBtn:boolean);
  430.     procedure DrawRadioControl(IsFocused:boolean);
  431.     procedure DrawScrew(X,Y,Nr:integer);
  432.     function GetSpinControlRect(CRect:TRect;IsClientRect:boolean):TRect;
  433.     procedure HistoryItemClick(Sender: TObject);
  434.     function IsInsideSpinControl(X,Y: Integer):boolean;
  435.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  436.     procedure Paint; override;
  437.     procedure ShowSliderEdit(AutoHide: boolean);
  438.  
  439.   public
  440.     constructor Create(AOwner: TComponent); override;
  441.     destructor Destroy; override;
  442.  
  443.   published
  444.     property Align;
  445.     {$IFDEF SR_Delphi5_Up}
  446.     property Anchors;
  447.     {$ENDIF}
  448.     property BevelStyle: TPanelBevel read FBevelStyle write SetBevelStyle;
  449.     property BevelWidth: integer read FBevelWidth write SetBevelWidth;
  450.     property BorderWidth: integer read FBorderWidth write SetBorderWidth;
  451.     property CaptureMouse: boolean read FCaptureMouse write FCaptureMouse;
  452.     property Colors: TColors read FColors write SetColors;
  453.     {$IFDEF SR_Delphi5_Up}
  454.     property Constraints;
  455.     {$ENDIF}
  456.     property Ctl3D;
  457.     property DecSeparator: char read FDecSeparator write SetDecSeparator;
  458.     property DecSeparatorPos: byte read FDecSeparatorPos write SetDecSeparatorPos;
  459.     property DragCursor;
  460.     {$IFDEF SR_Delphi5_Up}
  461.     property DragKind;
  462.     {$ENDIF}
  463.     property DragMode;
  464.     property Enabled;
  465.     property FocusRect: boolean read FFocusRect write SetFocusRect;
  466.     property Font;
  467.     property MaxValue: extended read FMaxValue write SetMaxValue;
  468.     property MinValue: extended read FMinValue write SetMinValue;
  469.     property NumDigits: TNumDigits read FNumDigits write SetNumDigits;
  470.     property ParentCtl3D;
  471.     property ParentShowHint;
  472.     property PopupMenu;
  473.     property SliderWidth: integer read FSliderWidth write FSliderWidth;
  474.     property ShowHint;
  475.     property ScrewSize: TScrewSize read FScrewSize write SetScrewSize;
  476.     property ShowScrews: boolean read FShowScrews write SetShowScrews;
  477.     property RulerDirection: TRulerDirection read FRulerDirection write SetRulerDirection;
  478.     property SliderEditLength: integer read FSliderEditLength write FSliderEditLength;
  479.     property SliderEditWidth: integer read FSliderEditWidth write SetSliderEditWidth;
  480.     property SpinBtnHeight: integer read FSpinBtnHeight write SetSpinBtnHeight;
  481.     property SpinControlWidth: integer read FSpinControlWidth write SetSpinControlWidth;
  482.     property TabOrder;
  483.     property TabStop;
  484.     property TickStyle : TTickStyle read FTickStyle write SetTickStyle;
  485.     property Value: extended read FValue write SetValue;
  486.     property ValueHistory: boolean read FValueHistory write FValueHistory;
  487.     property Visible;
  488.  
  489.     {$IFDEF SR_Delphi5_Up}
  490.     property OnCanResize;
  491.     {$ENDIF}
  492.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  493.     {$IFDEF SR_Delphi5_Up}
  494.     property OnConstrainedResize;
  495.     property OnContextPopup;
  496.     {$ENDIF}
  497.     property OnDblClick;
  498.     property OnDragDrop;
  499.     property OnDragOver;
  500.     property OnEndDrag;
  501.     property OnEnter;
  502.     property OnExit;
  503.     property OnHideSlider: TNotifyEvent read FOnHideSlider write FOnHideSlider;
  504.     property OnHistoryClick: TNotifyEvent read FOnHistoryClick write FOnHistoryClick;
  505.     property OnKeyDown;
  506.     property OnKeyPress;
  507.     property OnKeyUp;
  508.     property OnMouseDown;
  509.     property OnMouseMove;
  510.     property OnMouseUp;
  511.     {$IFDEF SR_Delphi4_Up}
  512.     property OnResize;
  513.     {$ENDIF}
  514.     property OnShowSlider: TNotifyEvent read FOnShowSlider write FOnShowSlider;
  515.     property OnSpinBtnClick: TNESpinBtnClick read FOnSpinBtnClick write FOnSpinBtnClick;
  516.     {$IFDEF SR_Delphi2_Up}
  517.     property OnStartDrag;
  518.     {$ENDIF}
  519.   end;
  520.  
  521. procedure Register;
  522.  
  523. implementation
  524.  
  525. {$IFDEF SR_Delphi2_Up}
  526. {$R *.D32}
  527. uses SRUtils, rrColors;
  528. {$ELSE}
  529. {$R *.D16}
  530. uses SRUtils;
  531. {$ENDIF}
  532.  
  533. const
  534.   DefaultRulerWidth   = 36;
  535.   DefaultRulerLength  = 140;
  536.   MaxTriangleHeight   = 6;
  537.   MaxTriangleWidth    = 10;
  538.   MaxHistoryItems     = 4;
  539.   DefaultThumbWidth   = 14;
  540.   FHLContrast         = 5;
  541.   FShContrast         = 4;
  542.   ResetBtnHeight      = 12;
  543.   ResetBtnWidth       = 15;
  544.  
  545. function XKoord(XMittel,XRadius,Grad:integer):integer;
  546. begin
  547.   Result:=round(XMittel-(sin(Grad*Pi/180)*XRadius));
  548. end; {XKoord}
  549.  
  550. function YKoord(YMittel,YRadius,Grad:integer):integer;
  551. begin
  552.   Result:=round(YMittel-(cos(Grad*Pi/180)*YRadius));
  553. end; {YKoord}
  554.  
  555. function Power10(Exponent:integer):integer;
  556. var i : integer;
  557. begin
  558.   Result:=1;
  559.   for i:=1 to Exponent do
  560.     Result:=Result*10;
  561. end; {Power10}
  562.  
  563. {$IFDEF SR_Delphi1}
  564. function ChangeBrightness(Color:TColor;Percentage:longint):TColor;
  565. var RGBColor       : longint;
  566.     Red,Green,Blue : byte;
  567.     NewR,NewG,NewB : longint;
  568.     Overflow       : longint;
  569. begin
  570.   RGBColor:=ColorToRGB(Color);
  571.   Overflow:=0;
  572.   { Rot }
  573.   Red:=GetRValue(RGBColor);
  574.   NewR:=Red+(Percentage*Red div 100);
  575.   if NewR>255 then begin
  576.     Overflow:=NewR-255;
  577.     NewG:=Overflow;
  578.     NewB:=Overflow;
  579.   end
  580.   else begin
  581.     NewG:=0;
  582.     NewB:=0;
  583.   end;
  584.   { Grⁿn }
  585.   Green:=GetGValue(RGBColor);
  586.   NewG:=NewG+Green+(Percentage*Green div 100);
  587.   if NewG>255 then begin
  588.     Overflow:=NewG-255;
  589.     NewR:=NewR+Overflow;
  590.     NewB:=Overflow;
  591.   end;
  592.   { Blau }
  593.   Blue:=GetBValue(RGBColor);
  594.   NewB:=NewB+Blue+(Percentage*Blue div 100);
  595.   if NewB>255 then begin
  596.     Overflow:=NewB-255;
  597.     if NewG<=255 then
  598.       NewR:=NewR+Overflow;
  599.   end;
  600.   if NewR>255 then
  601.     NewR:=255;
  602.   if NewG>255 then
  603.     NewG:=255;
  604.   if NewB>255 then
  605.     NewB:=255;
  606.   if NewR<0 then
  607.     NewR:=0;
  608.   if NewG<0 then
  609.     NewG:=0;
  610.   if NewB<0 then
  611.     NewB:=0;
  612.   Result:=NewR+(NewG shl 8)+(NewB shl 16);
  613. end; {ChangeBrightness}
  614. {$ENDIF}
  615.  
  616. procedure DrawBevel(ACanvas:TCanvas;ARect:TRect;Raised,Edge:boolean);
  617. begin
  618.   with ACanvas do begin
  619.     if Edge then begin
  620.       Pen.Color:=clBtnFace;
  621.       MoveTo(ARect.Right-1, ARect.Top);
  622.       LineTo(ARect.Left, ARect.Top);
  623.       LineTo(ARect.Left, ARect.Bottom-1);
  624.       Pen.Color:=clWindowFrame;
  625.       LineTo(ARect.Right-1, ARect.Bottom-1);
  626.       LineTo(ARect.Right-1, ARect.Top);
  627.       InflateRect(ARect, -1, -1);
  628.     end;
  629.     if Raised then
  630.       Pen.Color:=clBtnHighlight
  631.     else
  632.       Pen.Color:=clBtnShadow;
  633.     MoveTo(ARect.Right-1, ARect.Top);
  634.     LineTo(ARect.Left, ARect.Top);
  635.     LineTo(ARect.Left, ARect.Bottom-1);
  636.     if Raised then
  637.       Pen.Color:=clBtnShadow
  638.     else
  639.       Pen.Color:=clBtnHighlight;
  640.     LineTo(ARect.Right-1, ARect.Bottom-1);
  641.     LineTo(ARect.Right-1, ARect.Top);
  642.   end;
  643. end; {DrawBevel}
  644.  
  645. procedure DrawColorBevel(ACanvas:TCanvas;ARect:TRect;Raised,Edge:boolean;ColorHL,ColorSh:TColor);
  646. begin
  647.   with ACanvas do begin
  648.     if Edge then begin
  649.       Pen.Color:=clBtnFace;
  650.       MoveTo(ARect.Right-1, ARect.Top);
  651.       LineTo(ARect.Left, ARect.Top);
  652.       LineTo(ARect.Left, ARect.Bottom-1);
  653.       Pen.Color:=clWindowFrame;
  654.       LineTo(ARect.Right-1, ARect.Bottom-1);
  655.       LineTo(ARect.Right-1, ARect.Top);
  656.       InflateRect(ARect, -1, -1);
  657.     end;
  658.     if Raised then
  659.       Pen.Color:=ColorHL
  660.     else
  661.       Pen.Color:=ColorSh;
  662.     MoveTo(ARect.Right-1, ARect.Top);
  663.     LineTo(ARect.Left, ARect.Top);
  664.     LineTo(ARect.Left, ARect.Bottom-1);
  665.     if Raised then
  666.       Pen.Color:=ColorSh
  667.     else
  668.       Pen.Color:=ColorHL;
  669.     LineTo(ARect.Right-1, ARect.Bottom-1);
  670.     LineTo(ARect.Right-1, ARect.Top);
  671.   end;
  672. end; {DrawBevel}
  673.  
  674. procedure DrawDotLine(ACanvas:TCanvas;X1,Y1,Length:integer;Horizontal:boolean);
  675. var i : integer;
  676. begin
  677.   with ACanvas do begin
  678.     if Horizontal then begin
  679.       for i:=X1 to X1+Length-1 do
  680.         if odd(i) then
  681.           Pixels[i, Y1]:=Brush.Color;
  682.     end
  683.     else begin
  684.       for i:=Y1 to Y1+Length-1 do
  685.         if odd(i) then
  686.           Pixels[X1, i]:=Brush.Color;
  687.     end;
  688.   end;
  689. end;
  690.  
  691. procedure DrawLine(ACanvas:TCanvas;X1,Y1,X2,Y2:integer);
  692. begin
  693.   with ACanvas do begin
  694.     MoveTo(X1, Y1);
  695.     LineTo(X2, Y2);
  696.   end;
  697. end; {DrawLine}
  698.  
  699. procedure DrawTextComp(ACanvas:TCanvas;AText:string;var ARect:TRect;AFormat:Word);
  700. {$IFDEF SR_Delphi1}
  701. var CText : PChar;
  702. {$ENDIF}
  703. begin
  704.   {$IFDEF SR_Delphi1}
  705.   CText:=StrAlloc(255);
  706.   StrPCopy(CText, AText);
  707.   DrawText(ACanvas.Handle, CText, StrLen(CText), ARect, AFormat);
  708.   StrDispose(CText);
  709.   {$ELSE}
  710.   DrawText(ACanvas.Handle, PChar(AText), Length(AText), ARect, AFormat);
  711.   {$ENDIF}
  712. end;
  713.  
  714. procedure DrawTriangle(ACanvas:TCanvas;X,Y,Width,Height:integer;
  715.                        AColor:TColor;ADestination:TTriangleDest);
  716. var AWidth,
  717.     AHeight,
  718.     HDiff,
  719.     VDiff   : integer;
  720. begin
  721.   with ACanvas do begin
  722.     Brush.Color:=AColor;
  723.     Pen.Color:=AColor;
  724.     if (Height-7)>MaxTriangleHeight then
  725.       AHeight:=MaxTriangleHeight
  726.     else
  727.       AHeight:=Height-7;
  728.     AWidth:=AHeight*2;
  729.     HDiff:=AWidth div 2;
  730.     VDiff:=AHeight div 2;
  731.     X:=X+(Width div 2)-HDiff;
  732.     Y:=Y+(Height div 2)-VDiff-1;
  733.     if ADestination=tdTop then
  734.       Polygon([Point(X, Y+AHeight), Point(X+HDiff, Y), Point(X+AWidth, Y+AHeight)]);
  735.     if ADestination=tdRight then
  736.       Polygon([Point(X, Y), Point(X+AWidth, Y+VDiff), Point(X, Y+AHeight)]);
  737.     if ADestination=tdBottom then
  738.       Polygon([Point(X, Y), Point(X+HDiff, Y+AHeight), Point(X+AWidth, Y)]);
  739.     if ADestination=tdLeft then
  740.       Polygon([Point(X+AWidth, Y+AHeight), Point(X, Y+VDiff), Point(X+AWidth, Y)]);
  741.   end;
  742. end; {DrawTriangle}
  743.  
  744. { TColors }
  745.  
  746. constructor TColors.Create(AOwner: TComponent);
  747. begin
  748.   inherited Create;
  749.  
  750.   if AOwner is TCustomControl then
  751.     FOwner := TCustomControl(AOwner)
  752.   else
  753.     FOwner:=nil;
  754.   FBackground:=clBtnFace;
  755.   FNumBackground:=clBlack;
  756.   FNumFrame:=clWindowFrame;
  757.   FRuler:=clBtnFace;
  758.   FSliderBorder:=clSilver;
  759.   FSliderTop:=clBtnFace;
  760.   FSliderMark:=clBlue;
  761.   FTickMarks:=clBtnText;
  762.  
  763.   AssignBevelColors(FSliderBorder, FBorderHL, FBorderSh, FHLContrast, FShContrast);
  764. end;
  765.  
  766. procedure TColors.Assign(Source: TPersistent);
  767. begin
  768.   Background:=TColors(Source).Background;
  769.   NumBackground:=TColors(Source).NumBackground;
  770.   NumFrame:=TColors(Source).NumFrame;
  771.   Ruler:=TColors(Source).Ruler;
  772.   SliderBorder:=TColors(Source).SliderBorder;
  773.   SliderTop:=TColors(Source).SliderTop;
  774.   SliderMark:=TColors(Source).SliderMark;
  775.   TickMarks:=TColors(Source).TickMarks;
  776. end;
  777.  
  778. procedure TColors.AssignBevelColors(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;HLContrast,ShContrast:integer);
  779. begin
  780.   {$IFDEF SR_Delphi1}
  781.   HighlightColor:=ChangeBrightness(FaceColor, 100 div 10*HLContrast);
  782.   ShadowColor:=ChangeBrightness(FaceColor, -100 div 10*ShContrast);
  783.   {$ELSE}
  784.   Get3DColors(FaceColor, HighlightColor, ShadowColor,
  785.               (10-HLContrast)/10, (10-ShContrast)/10);
  786.   {$ENDIF}
  787. end; {AssignBevelColors}
  788.  
  789. procedure TColors.SetBackground(NewValue: TColor);
  790. begin
  791.   if NewValue<>FBackground then begin
  792.     FBackground:=NewValue;
  793.     if Assigned(FOwner) then
  794.       FOwner.Invalidate;
  795.   end;
  796. end;
  797.  
  798. procedure TColors.SetNumBackground(NewValue: TColor);
  799. begin
  800.   if NewValue<>FNumBackground then begin
  801.     FNumBackground:=NewValue;
  802.     if Assigned(FOwner) then
  803.       FOwner.Invalidate;
  804.     if Assigned(FOwner) and (FOwner is TSRValueEdit) and assigned(TSRValueEdit(FOwner).FNumericEdit) then
  805.       TSRValueEdit(FOwner).FNumericEdit.SetColor(NewValue);
  806.   end;
  807. end;
  808.  
  809. procedure TColors.SetNumFrame(NewValue: TColor);
  810. begin
  811.   if NewValue<>FNumFrame then begin
  812.     FNumFrame:=NewValue;
  813.     if Assigned(FOwner) then
  814.       FOwner.Invalidate;
  815.     if Assigned(FOwner) and (FOwner is TSRValueEdit) and assigned(TSRValueEdit(FOwner).FNumericEdit) then
  816.       TSRValueEdit(FOwner).FNumericEdit.SetFrameColor(NewValue);
  817.   end;
  818. end;
  819.  
  820. procedure TColors.SetRuler(NewValue: TColor);
  821. begin
  822.   if NewValue<>FRuler then begin
  823.     FRuler:=NewValue;
  824.     if Assigned(FOwner) then
  825.       FOwner.Invalidate;
  826.   end;
  827. end;
  828.  
  829. procedure TColors.SetSliderBorder(NewValue: TColor);
  830. begin
  831.   if NewValue<>FSliderBorder then begin
  832.     FSliderBorder:=NewValue;
  833.     AssignBevelColors(FSliderBorder, FBorderHL, FBorderSh, FHLContrast, FShContrast);
  834.     if Assigned(FOwner) then
  835.       FOwner.Invalidate;
  836.   end;
  837. end;
  838.  
  839. procedure TColors.SetSliderMark(NewValue: TColor);
  840. begin
  841.   if NewValue<>FSliderMark then begin
  842.     FSliderMark:=NewValue;
  843.     if Assigned(FOwner) then
  844.       FOwner.Invalidate;
  845.   end;
  846. end;
  847.  
  848. procedure TColors.SetSliderTop(NewValue: TColor);
  849. begin
  850.   if NewValue<>FSliderTop then begin
  851.     FSliderTop:=NewValue;
  852.     if Assigned(FOwner) then
  853.       FOwner.Invalidate;
  854.   end;
  855. end;
  856.  
  857. procedure TColors.SetTickMarks(NewValue: TColor);
  858. begin
  859.   if NewValue<>FTickMarks then begin
  860.     FTickMarks:=NewValue;
  861.     if Assigned(FOwner) then
  862.       FOwner.Invalidate;
  863.   end;
  864. end;
  865.  
  866. { TNumericEdit }
  867.  
  868. constructor TNumericEdit.Create(AOwner: TComponent);
  869. begin
  870.   inherited Create(AOwner);
  871.  
  872.   Height:=41;
  873.   Width:=60;
  874.  
  875.   FAutoSize:=true;
  876.   FBtnHeight:=10;
  877.   FDecSeparator:='.';
  878.   FDecSeparatorPos:=0;
  879.   FDownIdxTop:=-1;
  880.   FDownIdxBtm:=-1;
  881.   FEditPos:=0;
  882.   FNumDigits:=4;
  883.   FMaxValue:=9999;
  884.   FMinValue:=-9999;
  885.  
  886.   FDrawBuffer:=TBitmap.Create;
  887.  
  888.   Font.Color:=clLime;
  889.   Font.Style:=[fsBold];
  890. end;
  891.  
  892. destructor TNumericEdit.Destroy;
  893. begin
  894.   if assigned(FDrawBuffer) then
  895.     FreeAndNil(FDrawBuffer);
  896.  
  897.   inherited Destroy;
  898. end;
  899.  
  900. procedure TNumericEdit.CalcControlHeight;
  901. var DC: HDC;
  902. begin
  903.   DC:=GetDC(0);
  904.   Canvas.Handle:=DC;
  905.   Canvas.Font.Assign(Font);
  906.   Height:=Canvas.TextHeight('0,2')+(2*FBtnHeight)+4;
  907.   Canvas.Handle:=0;
  908.   ReleaseDC(0, DC);
  909. end;
  910.  
  911. procedure TNumericEdit.CalcDigitWidth;
  912. begin
  913.   FDigitWidth:=(Width-2) div (FNumDigits+1);
  914. end;
  915.  
  916. procedure TNumericEdit.Change;
  917. begin
  918.   if assigned(FValueEdit) then
  919.     FValueEdit.SetValue(FValue);
  920.   Invalidate;
  921.   if assigned(FOnChange) then
  922.     FOnChange(Self);
  923. end;
  924.  
  925. procedure TNumericEdit.CMCtl3DChanged(var Message: TMessage);
  926. begin
  927.   inherited;
  928.   invalidate;
  929. end;
  930.  
  931. procedure TNumericEdit.CMFontChanged(var Message: TMessage);
  932. begin
  933.   inherited;
  934.   if FAutoSize then
  935.     CalcControlHeight;
  936. end;
  937.  
  938. procedure TNumericEdit.DoSpinBtnClick(BtnIndex:integer;UpBtn:boolean);
  939. begin
  940.   if assigned(FOnSpinBtnClick) then
  941.     FOnSpinBtnClick(Self, BtnIndex, UpBtn);
  942. end;
  943.  
  944. procedure TNumericEdit.DrawDigit(ACanvas:TCanvas;ARect:TRect;AValue:byte;Editing:boolean);
  945. var AText : string;
  946. begin
  947.   AText:=IntToStr(AValue);
  948.   InflateRect(ARect, -1, -1);
  949.   with ACanvas do begin
  950.     Font.Assign(Self.Font);
  951. {    if FHasFocus and Editing and
  952.      assigned(FValueEdit) and not assigned(FValueEdit.FSliderEdit) then begin}
  953.     if FHasFocus and Editing then begin
  954.       Brush.Color:=clHighlight;
  955.       Font.Color:=clHighlightText;
  956.       FillRect(ARect);
  957.     end;
  958.     Brush.Style:=bsClear;
  959.     DrawTextComp(ACanvas, AText, ARect, DT_SingleLine or DT_VCenter or DT_Center);
  960.     Brush.Style:=bsSolid;
  961.   end;
  962. end; {DrawDigit}
  963.  
  964. function TNumericEdit.GetDigitValue(DigitIndex:byte):byte;
  965. var Temp1,
  966.     Temp2 : integer;
  967. begin
  968.   Temp1:=trunc(FValue*Power10(FDecSeparatorPos));
  969.   Temp2:=Temp1 div Power10(FNumDigits-DigitIndex-1);
  970.   Result:=abs(Temp2 mod 10);
  971. end;
  972.  
  973. function TNumericEdit.GetSpinButtonIndex(X,Y:integer;var UpperRow:boolean):integer;
  974. var NumRect : TRect;
  975.     OnBtn   : boolean;
  976. begin
  977.   OnBtn:=false;
  978.   NumRect:=ClientRect;
  979.   if Y<(NumRect.Top+FBtnHeight) then begin
  980.     UpperRow:=true;
  981.     OnBtn:=true;
  982.   end;
  983.   if Y>(NumRect.Bottom-FBtnHeight) then begin
  984.     UpperRow:=false;
  985.     OnBtn:=true;
  986.   end;
  987.   if OnBtn then
  988.     Result:=(X div FDigitWidth)
  989.   else
  990.     Result:=-1;
  991. end;
  992.  
  993. function TNumericEdit.GetMaxValue:extended;
  994. var FracPart  : extended;
  995.     TruncPart : integer;
  996. begin
  997.   if FDecSeparatorPos=0 then
  998.     FracPart:=0
  999.   else
  1000.     FracPart:=1/Power10(FDecSeparatorPos);
  1001.   TruncPart:=Power10(FNumDigits);
  1002.   Result:=TruncPart-FracPart;
  1003. end;
  1004.  
  1005. procedure TNumericEdit.IncreaseDigitValue(DigitIndex:byte;Increment:integer);
  1006. var OldValue : byte;
  1007.     NewValue : integer;
  1008. begin
  1009.   OldValue:=GetDigitValue(DigitIndex);
  1010.   NewValue:=OldValue+Increment;
  1011.   if (NewValue>=0) and (NewValue<=9) then
  1012.     SetDigitValue(DigitIndex, NewValue);
  1013. end;
  1014.  
  1015. procedure TNumericEdit.KeyDown(var Key: Word; Shift: TShiftState);
  1016. begin
  1017.   if (FEditPos>0) and (Key=VK_Left) then
  1018.     SetEditPos(FEditPos-1);
  1019.   if (FEditPos<(FNumDigits-1)) and (Key=VK_Right) then
  1020.     SetEditPos(FEditPos+1);
  1021.   if Key=VK_Up then
  1022.     SpinButtonDown(FEditPos+1, true);
  1023.   if Key=VK_Down then
  1024.     SpinButtonDown(FEditPos+1, false);
  1025.   if Key=VK_Back then begin
  1026.     if FEditPos>0 then
  1027.       SetEditPos(EditPos-1);
  1028.     SetDigitValue(EditPos, 0);
  1029.   end;
  1030.   if Key=VK_Delete then
  1031.     SetDigitValue(FEditPos, 0);
  1032.   if Key=VK_Home then
  1033.     SetEditPos(0);
  1034.   if Key=VK_End then
  1035.     SetEditPos(FNumDigits-1);
  1036.  
  1037.   inherited KeyDown(Key, Shift);
  1038. end;
  1039.  
  1040. procedure TNumericEdit.KeyPress(var Key: Char);
  1041. var AValue : byte;
  1042. begin
  1043.   if (Key='-') and (-abs(FValue)>=FMinValue) then
  1044.     SetValue(-abs(FValue));
  1045.   if (Key='+') and (abs(FValue)<=FMaxValue)then
  1046.     SetValue(abs(FValue));
  1047.   if Key in ['0'..'9'] then begin
  1048.     AValue:=ord(Key)-ord('0');
  1049.     SetDigitValue(FEditPos, AValue);
  1050.     if EditPos<(NumDigits-1) then
  1051.       SetEditPos(FEditPos+1);
  1052.   end;
  1053.  
  1054.   inherited KeyPress(Key);
  1055. end;
  1056.  
  1057. procedure TNumericEdit.KeyUp(var Key: Word; Shift: TShiftState);
  1058. begin
  1059.   if (Key=VK_Up) then
  1060.     SpinButtonUp(FEditPos, true);
  1061.   if (Key=VK_Down) then
  1062.     SpinButtonUp(FEditPos, false);
  1063.  
  1064.   inherited KeyUp(Key, Shift);
  1065. end;
  1066.  
  1067. procedure TNumericEdit.Loaded;
  1068. var AValue : extended;
  1069. begin
  1070.   inherited Loaded;
  1071.  
  1072.   if FMaxValue=FMinValue then begin
  1073.     if (FMaxValue=0) and (FMinValue=0) then begin
  1074.       AValue:=GetMaxValue;
  1075.       SetMaxValue(AValue);
  1076.       SetMinValue(-AValue);
  1077.     end
  1078.     else
  1079.       SetMaxValue(FMinValue+1);
  1080.   end;
  1081.   if FAutoSize then
  1082.     CalcControlHeight;
  1083. end;
  1084.  
  1085. procedure TNumericEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1086. var BtnIdx : integer;
  1087.     SpinUp : boolean;
  1088. begin
  1089.   if assigned(FValueEdit) and FValueEdit.Enabled then
  1090.     FValueEdit.SetFocus
  1091.   else
  1092.     SetFocus;
  1093.   if (Button=mbLeft) then begin
  1094.     BtnIdx:=(X div FDigitWidth);
  1095.     if (BtnIdx>0) and (BtnIdx<=FNumDigits) then
  1096.       SetEditPos(BtnIdx-1);
  1097.     if (Y<=FBtnHeight) or (Y>=(Height-FBtnHeight)) then begin
  1098.       { Maus ist im SpinButton-Bereich }
  1099.       BtnIdx:=GetSpinButtonIndex(X, Y, SpinUp);
  1100.       if BtnIdx>=0 then
  1101.         SpinButtonDown(BtnIdx, SpinUp);
  1102.     end;
  1103.   end;
  1104.  
  1105.   inherited MouseDown(Button, Shift, X, Y);
  1106. end;
  1107.  
  1108. procedure TNumericEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1109. begin
  1110.   if (Button=mbLeft) then begin
  1111.     if FDownIdxTop>=0 then
  1112.       SpinButtonUp(FDownIdxTop, true);
  1113.     if FDownIdxBtm>=0 then
  1114.       SpinButtonUp(FDownIdxBtm, false);
  1115.   end;
  1116.  
  1117.   inherited MouseUp(Button, Shift, X, Y);
  1118. end;
  1119.  
  1120. procedure TNumericEdit.Paint;
  1121. var BRect,
  1122.     CRect  : TRect;
  1123.     AText  : string;
  1124.     i,AVal : integer;
  1125. begin
  1126.   CRect:=ClientRect;
  1127.   with FDrawBuffer.Canvas do begin
  1128.     { Rahmen }
  1129.     if Ctl3D then
  1130.       DrawBevel(FDrawBuffer.Canvas, CRect, false, false)
  1131.     else begin
  1132.       Brush.Color:=clBlack;
  1133.       FrameRect(CRect);
  1134.     end;
  1135.     { SpinButtons }
  1136.     Brush.Color:=clBtnFace;
  1137.     BRect:=Rect(CRect.Left+1, CRect.Top+1,
  1138.                 CRect.Right-1, 1+FBtnHeight);
  1139.     FillRect(BRect);
  1140.     BRect:=Rect(CRect.Left+1, CRect.Bottom-FBtnHeight-1,
  1141.                 CRect.Right-1, CRect.Bottom-1);
  1142.     FillRect(BRect);
  1143.     for i:=0 to FNumDigits do begin
  1144.       BRect.Left:=(i*FDigitWidth)+1;
  1145.       BRect.Top:=1;
  1146.       BRect.Right:=BRect.Left+FDigitWidth;
  1147.       BRect.Bottom:=BRect.Top+FBtnHeight;
  1148.       DrawBevel(FDrawBuffer.Canvas, BRect, (FDownIdxTop<>i) or (i<0), true);
  1149.       DrawTriangle(FDrawBuffer.Canvas, BRect.Left, BRect.Top,
  1150.                    BRect.Right-BRect.Left, BRect.Bottom-BRect.Top,
  1151.                    clBtnText, tdTop);
  1152.       BRect.Bottom:=CRect.Bottom-1;
  1153.       BRect.Top:=BRect.Bottom-FBtnHeight;
  1154.       DrawBevel(FDrawBuffer.Canvas, BRect, (FDownIdxBtm<>i) or (i<0), true);
  1155.       DrawTriangle(FDrawBuffer.Canvas, BRect.Left, BRect.Top,
  1156.                    BRect.Right-BRect.Left, BRect.Bottom-BRect.Top,
  1157.                    clBtnText, tdBottom);
  1158.     end;
  1159.     if BRect.Right<(CRect.Right-3) then begin
  1160.       BRect.Left:=((FNumDigits+1)*FDigitWidth)+1;
  1161.       BRect.Top:=1;
  1162.       BRect.Right:=CRect.Right-1;
  1163.       BRect.Bottom:=BRect.Top+FBtnHeight;
  1164.       DrawBevel(FDrawBuffer.Canvas, BRect, true, true);
  1165.       BRect.Bottom:=CRect.Bottom-1;
  1166.       BRect.Top:=BRect.Bottom-FBtnHeight;
  1167.       DrawBevel(FDrawBuffer.Canvas, BRect, true, true);
  1168.     end;
  1169.     { Hintergrund }
  1170.     Brush.Color:=FColor;
  1171.     Pen.Color:=FFrameColor;
  1172.     BRect.Left:=+1;
  1173.     BRect.Top:=FBtnHeight;
  1174.     BRect.Right:=CRect.Right-1;
  1175.     BRect.Bottom:=CRect.Bottom-FBtnHeight-1;
  1176.     Rectangle(BRect.Left, BRect.Top, BRect.Right, BRect.Bottom);
  1177.     { Digits }
  1178.     for i:=0 to FNumDigits do begin
  1179.       BRect.Left:=(i*FDigitWidth)+1;
  1180.       BRect.Top:=FBtnHeight;
  1181.       BRect.Right:=BRect.Left+FDigitWidth-1;
  1182.       BRect.Bottom:=CRect.Bottom-FBtnHeight-1;
  1183.       if i=0 then begin
  1184.         Font.Assign(Self.Font);
  1185.         if FValue<0 then
  1186.           DrawText(Handle, '-', 1, BRect,
  1187.                    DT_SingleLine or DT_VCenter or DT_Center);
  1188.         if FValue>0 then
  1189.           DrawText(Handle, '+', 1, BRect,
  1190.                    DT_SingleLine or DT_VCenter or DT_Center);
  1191.       end
  1192.       else begin
  1193.         AVal:=GetDigitValue(i-1);
  1194.         DrawDigit(FDrawBuffer.Canvas, BRect, AVal, EditPos=(i-1));
  1195.       end;
  1196.     end;
  1197.     { Separator }
  1198.     if FDecSeparatorPos>0 then begin
  1199.       AText:=FDecSeparator;
  1200.       Font.Assign(Self.Font);
  1201.       Brush.Style:=bsClear;
  1202.       TextOut(((FNumDigits-FDecSeparatorPos+1)*FDigitWidth)-(TextWidth(AText) div 2)+1,
  1203.               (CRect.Bottom-CRect.Top-TextHeight('0')) div 2, AText);
  1204.       Brush.Style:=bsSolid;
  1205.     end;
  1206.  
  1207.   end;
  1208.   Canvas.Draw(0, 0, FDrawBuffer);
  1209. end;
  1210.  
  1211. procedure TNumericEdit.SetAutoSize(newValue: boolean);
  1212. begin
  1213.   if newValue<>FAutoSize then begin
  1214.     FAutoSize:=newValue;
  1215.     if FAutoSize then begin
  1216.       CalcControlHeight;
  1217.       Invalidate;
  1218.     end;
  1219.   end;
  1220. end;
  1221.  
  1222. procedure TNumericEdit.SetBtnHeight(newValue: integer);
  1223. begin
  1224.   if newValue<>FBtnHeight then begin
  1225.     FBtnHeight:=newValue;
  1226.     if FAutoSize then
  1227.       CalcControlHeight;
  1228.     Invalidate;
  1229.   end;
  1230. end;
  1231.  
  1232. procedure TNumericEdit.SetColor(newValue: TColor);
  1233. begin
  1234.   if newValue<>FColor then begin
  1235.     FColor:=newValue;
  1236.     Invalidate;
  1237.   end;
  1238. end;
  1239.  
  1240. procedure TNumericEdit.SetDecSeparator(newValue: char);
  1241. begin
  1242.   if NewValue<>FDecSeparator then begin
  1243.     FDecSeparator:=NewValue;
  1244.     Invalidate;
  1245.   end;
  1246. end;
  1247.  
  1248. procedure TNumericEdit.SetDecSeparatorPos(newValue: byte);
  1249. var NumMax : extended;
  1250. begin
  1251.   if NewValue<>FDecSeparatorPos then begin
  1252.     FDecSeparatorPos:=NewValue;
  1253.     NumMax:=GetMaxvalue;
  1254.     if FMaxValue>NumMax then
  1255.       FMaxValue:=NumMax;
  1256.     if abs(FMinValue)>NumMax then
  1257.       FMinValue:=-NumMax;
  1258.     Invalidate;
  1259.   end;
  1260. end;
  1261.  
  1262. procedure TNumericEdit.SetDigitValue(DigitIndex:byte;Value:byte);
  1263. var NewVal     : integer;
  1264.     ResultVal  : extended;
  1265.     DigitVal,i : byte;
  1266. begin
  1267.   NewVal:=Value*Power10(FNumDigits-DigitIndex-1);
  1268.   for i:=0 to FNumDigits-1 do begin
  1269.     if i<>DigitIndex then begin
  1270.       DigitVal:=GetDigitValue(i);
  1271.       NewVal:=NewVal+DigitVal*Power10(FNumDigits-i-1);
  1272.     end;
  1273.   end;
  1274.   ResultVal:=NewVal/Power10(FDecSeparatorPos);
  1275.   if FValue<0 then
  1276.     SetValue(-ResultVal)
  1277.   else
  1278.     SetValue(ResultVal);
  1279. end;
  1280.  
  1281. procedure TNumericEdit.SetEditPos(newValue: byte);
  1282. begin
  1283.   if newValue<>FEditPos then begin
  1284.     FEditPos:=newValue;
  1285.     Invalidate;
  1286.   end;
  1287. end;
  1288.  
  1289. procedure TNumericEdit.SetFrameColor(newValue: TColor);
  1290. begin
  1291.   if newValue<>FFrameColor then begin
  1292.     FFrameColor:=newValue;
  1293.     Invalidate;
  1294.   end;
  1295. end;
  1296.  
  1297. procedure TNumericEdit.SetMaxValue(newValue: extended);
  1298. var NumMax : extended;
  1299. begin
  1300.   if NewValue<>FMaxValue then begin
  1301.     NumMax:=GetMaxValue;
  1302.     if NewValue>NumMax then
  1303.       NewValue:=NumMax;
  1304.     FMaxValue:=NewValue;
  1305.     if FValue>FMaxValue then
  1306.       SetValue(FMaxValue);
  1307.   end;
  1308. end;
  1309.  
  1310. procedure TNumericEdit.SetMinValue(newValue: extended);
  1311. var NumMax : extended;
  1312. begin
  1313.   if NewValue<>FMinValue then begin
  1314.     NumMax:=-GetMaxValue;
  1315.     if NewValue<NumMax then
  1316.       NewValue:=NumMax;
  1317.     FMinValue:=NewValue;
  1318.     if FValue<FMinValue then
  1319.       SetValue(FMinValue);
  1320.   end;
  1321. end;
  1322.  
  1323. procedure TNumericEdit.SetNumDigits(newValue: TNumDigits);
  1324. var NumMax : extended;
  1325. begin
  1326.   if newValue<>FNumDigits then begin
  1327.     FNumDigits:=newValue;
  1328.     CalcDigitWidth;
  1329.     NumMax:=GetMaxvalue;
  1330.     if FMaxValue>NumMax then
  1331.       FMaxValue:=NumMax;
  1332.     if abs(FMinValue)>NumMax then
  1333.       FMinValue:=-NumMax;
  1334.     Invalidate;
  1335.   end;
  1336. end;
  1337.  
  1338. procedure TNumericEdit.SetValue(newValue: extended);
  1339. begin
  1340.   if newValue>FMaxValue then
  1341.     newValue:=FMaxValue;
  1342.   if newValue<FMinValue then
  1343.     newValue:=FMinValue;
  1344.   if newValue<>FValue then begin
  1345.     FValue:=newValue;
  1346.     Change;
  1347.   end;
  1348. end;
  1349.  
  1350. procedure TNumericEdit.SpinButtonDown(ButtonIndex:integer;SpinUp:boolean);
  1351. begin
  1352.   if SpinUp then begin
  1353.     FDownIdxTop:=ButtonIndex;
  1354.     if ButtonIndex>0 then
  1355.       IncreaseDigitValue(ButtonIndex-1, 1)
  1356.     else
  1357.       SetValue(-FValue);
  1358.   end
  1359.   else begin
  1360.     FDownIdxBtm:=ButtonIndex;
  1361.     if ButtonIndex>0 then
  1362.       IncreaseDigitValue(ButtonIndex-1, -1)
  1363.     else
  1364.       SetValue(-FValue);
  1365.   end;
  1366.   Invalidate;
  1367.   if assigned(FOnSpinBtnClick) then
  1368.     DoSpinBtnClick(ButtonIndex, SpinUp);
  1369. {  if assigned(FValueEdit) and assigned(FValueEdit.FOnSpinBtnClick) then
  1370.     FValueEdit.DoSpinBtnClick(ButtonIndex, SpinUp);}
  1371. end;
  1372.  
  1373. procedure TNumericEdit.SpinButtonUp(ButtonIndex:integer;SpinUp:boolean);
  1374. begin
  1375.   FDownIdxTop:=-1;
  1376.   FDownIdxBtm:=-1;
  1377.   Invalidate;
  1378. end;
  1379.  
  1380. procedure TNumericEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  1381. begin
  1382.   Message.Result := 1;
  1383. end;
  1384.  
  1385. procedure TNumericEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  1386. begin
  1387.   inherited;
  1388.   { Kein Fokuswechsel durch Cursortasten }
  1389.   Message.Result:=Message.Result or DLGC_WANTARROWS;
  1390. end;
  1391.  
  1392. procedure TNumericEdit.WMKillFocus(var Message: TWMKillFocus);
  1393. begin
  1394.   inherited;
  1395.  
  1396.   FHasFocus:=false;
  1397.   Invalidate;
  1398. end;
  1399.  
  1400. procedure TNumericEdit.WMSetFocus(var Message: TWMSetFocus);
  1401. begin
  1402.   inherited;
  1403.  
  1404.   FHasFocus:=true;
  1405.   Invalidate;
  1406. end;
  1407.  
  1408. procedure TNumericEdit.WMSize(var Message: TWMSize);
  1409. begin
  1410.   inherited;
  1411.  
  1412.   FDrawBuffer.Width:=Width;
  1413.   FDrawBuffer.Height:=Height;
  1414.   CalcDigitWidth;
  1415.   Message.Result := 0;
  1416. end;
  1417.  
  1418.  
  1419. { TSliderEdit }
  1420.  
  1421. constructor TSliderEdit.Create(AOwner: TComponent);
  1422. begin
  1423.   inherited Create(AOwner);
  1424.  
  1425.   FColors := TColors.Create(Self);
  1426.   FDrawBuffer:=TBitmap.Create;
  1427.  
  1428.   Width:=DefaultRulerWidth;
  1429.   Height:=DefaultRulerLength;
  1430.  
  1431.   FAutoHide:=false;
  1432.   FBevelStyle:=bvRaised;
  1433.   FBevelWidth:=1;
  1434.   FBorderWidth:=2;
  1435.   FDisplayWidth:=30;
  1436.   FDownIndex:=-1;
  1437.   FSliderWidth:=DefaultThumbWidth;
  1438.   FRulerDirection:=rdVertical;
  1439.   FSpinBtnHeight:=10;
  1440.   FTickStyle:=tsAll;
  1441.   FValueEdit:=nil;
  1442.  
  1443.   Font.Color:=clLime;
  1444.   Font.Style:=[fsBold];
  1445.   CalcDisplayHeight;
  1446. end;
  1447.  
  1448. destructor TSliderEdit.Destroy;
  1449. begin
  1450.   if assigned(FColors) then
  1451.     FreeAndNil(FColors);
  1452.   if assigned(FDrawBuffer) then
  1453.     FreeAndNil(FDrawBuffer);
  1454.  
  1455.   inherited Destroy;
  1456. end;
  1457.  
  1458. procedure TSliderEdit.CalcDisplayHeight;
  1459. var DC: HDC;
  1460. begin
  1461.   if not (csLoading in ComponentState) and not (csReading in ComponentState) then begin
  1462.     DC:=GetDC(0);
  1463.     Canvas.Handle:=DC;
  1464.     Canvas.Font.Assign(Font);
  1465.     FDisplayHeight:=Canvas.TextHeight('0')+2;
  1466.     Canvas.Handle:=0;
  1467.     ReleaseDC(0, DC);
  1468.   end;
  1469. end;
  1470.  
  1471. procedure TSliderEdit.CMFontChanged(var Message: TMessage);
  1472. begin
  1473.   inherited;
  1474.   CalcDisplayHeight;
  1475. end;
  1476.  
  1477. procedure TSliderEdit.DoDrawFocusRect(ACanvas:TCanvas);
  1478. var CRect : TRect;
  1479. begin
  1480.   CRect:=ClientRect;
  1481.   InflateRect(CRect, -FBevelWidth-FBorderWidth, -FBevelWidth-FBorderWidth);
  1482.   if FRulerDirection=rdHorizontal then begin
  1483.     CRect.Left:=CRect.Left+(FDisplayWidth div 2)+2;
  1484.     CRect.Right:=CRect.Right-FDisplayWidth-2;
  1485.   end
  1486.   else begin
  1487.     CRect.Top:=CRect.Top+FDisplayHeight+FSpinBtnHeight+4;
  1488.     CRect.Bottom:=CRect.Bottom-FSpinBtnHeight-3;
  1489.   end;
  1490.   InflateRect(CRect, -2, -2);
  1491.   ACanvas.Brush.Color:=clBlack;
  1492.   ACanvas.Pen.Color:=clBlack;
  1493.   DrawDotLine(ACanvas, CRect.Left+1, CRect.Top, CRect.Right-CRect.Left-2, true);
  1494.   DrawDotLine(ACanvas, CRect.Right-1, CRect.Top+1, CRect.Bottom-CRect.Top-2, false);
  1495.   DrawDotLine(ACanvas, CRect.Left+1, CRect.Bottom-1, CRect.Right-CRect.Left-2, true);
  1496.   DrawDotLine(ACanvas, CRect.Left, CRect.Top+1, CRect.Bottom-CRect.Top-2, false);
  1497. end;
  1498.  
  1499. procedure TSliderEdit.DoSpinBtnClick(const UpBtn:boolean;Shift:TShiftState);
  1500. var AValue : integer;
  1501. begin
  1502.   if ssShift in Shift then
  1503.     AValue:=10
  1504.   else begin
  1505.     if ssCtrl in Shift then
  1506.       AValue:=100
  1507.     else
  1508.       AValue:=1;
  1509.   end;
  1510.   if UpBtn then begin
  1511.     FDownIndex:=1;
  1512.     SetValue(FValue-AValue);
  1513.   end
  1514.   else begin
  1515.     FDownIndex:=0;
  1516.     SetValue(FValue+AValue);
  1517.   end;
  1518. end;
  1519.  
  1520. procedure TSliderEdit.DrawValueDisplay(ACanvas:TCanvas;ARect:TRect);
  1521. var SRect  : TRect;
  1522.     SWidth : integer;
  1523.     AText  : string;
  1524. begin
  1525.   with ACanvas do begin
  1526.     { Wertanzeige zeichnen }
  1527.     SRect:=Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Top+FDisplayHeight);
  1528.     Brush.Color:=FColors.NumBackground;
  1529.     FillRect(SRect);
  1530.     AText:=IntToStr(FValue);
  1531.     Font.Assign(Self.Font);
  1532.     DrawTextComp(ACanvas, AText, SRect,
  1533.                  DT_SingleLine or DT_Center or DT_VCenter);
  1534.     DrawBevel(ACanvas, SRect, false, false);
  1535.  
  1536.     { SpinButtons zeichnen }
  1537.     SRect.Top:=ARect.Bottom-FSpinBtnHeight;
  1538.     SRect.Bottom:=ARect.Bottom;
  1539.     SWidth:=(ARect.Right-ARect.Left) div 2;
  1540.     SRect.Right:=SRect.Left+SWidth;
  1541.     Brush.Color:=clBtnFace;
  1542.     FillRect(SRect);
  1543.     DrawBevel(ACanvas, SRect, FDownIndex<>0, true);
  1544.     DrawTriangle(ACanvas, SRect.Left, SRect.Top,
  1545.                  SRect.Right-SRect.Left, SRect.Bottom-SRect.Top,
  1546.                  clBtnText, tdTop);
  1547.     SRect.Left:=ARect.Right-SWidth;
  1548.     SRect.Right:=ARect.Right;
  1549.     Brush.Color:=clBtnFace;
  1550.     FillRect(SRect);
  1551.     DrawBevel(ACanvas, SRect, FDownIndex<>1, true);
  1552.     DrawTriangle(ACanvas, SRect.Left, SRect.Top,
  1553.                  SRect.Right-SRect.Left, SRect.Bottom-SRect.Top,
  1554.                  clBtnText, tdBottom);
  1555.   end;
  1556. end;
  1557.  
  1558. procedure TSliderEdit.DrawResetButtons(ACanvas:TCanvas;ARect:TRect);
  1559. var SRect  : TRect;
  1560.     SWidth : integer;
  1561. begin
  1562.   with ACanvas do begin
  1563.     { Reset-Button zeichnen }
  1564.     SRect:=ARect;
  1565.     SWidth:=(ARect.Right-ARect.Left) div 2;
  1566.     if FRulerDirection=rdHorizontal then
  1567.       SRect.Bottom:=SRect.Top+ResetBtnHeight
  1568.     else
  1569.       SRect.Right:=SRect.Left+SWidth;
  1570.     Brush.Color:=clBtnFace;
  1571.     FillRect(SRect);
  1572.     DrawBevel(ACanvas, SRect, FDownIndex<>2, true);
  1573.     Font.Name:='Small Fonts';
  1574.     Font.Size:=6;
  1575.     Font.Style:=[];
  1576.     Font.Color:=clBtnText;
  1577.     Brush.Style:=bsClear;
  1578.     DrawText(Handle, '0', 1, SRect, DT_SingleLine or DT_Center or DT_VCenter);
  1579.     Brush.Style:=bsSolid;
  1580.  
  1581.     if assigned(FValueEdit) then begin
  1582.       { Close-Button zeichnen }
  1583.       SRect:=ARect;
  1584.       if FRulerDirection=rdHorizontal then
  1585.         SRect.Top:=ARect.Bottom-ResetBtnHeight
  1586.       else
  1587.         SRect.Left:=ARect.Right-SWidth;
  1588.       Brush.Color:=clBtnFace;
  1589.       FillRect(SRect);
  1590.       DrawBevel(ACanvas, SRect, FDownIndex<>3, true);
  1591.       Font.Color:=clRed;
  1592.       Brush.Style:=bsClear;
  1593.       DrawText(Handle, 'X', 1, SRect, DT_SingleLine or DT_Center or DT_VCenter);
  1594.       Brush.Style:=bsSolid;
  1595.     end;
  1596.   end;
  1597. end;
  1598.  
  1599. procedure TSliderEdit.DrawRuler(ACanvas:TCanvas;ARect:TRect;DrawFocus:boolean);
  1600. var SRect          : TRect;
  1601.     SWidth,SHeight,
  1602.     RulerPosition,
  1603.     HalfSlidWidth,
  1604.     HalfWidth,
  1605.     TickLength,i   : integer;
  1606.     TickSpace      : single;
  1607.  
  1608.   procedure DrawTick(X,Y,TickLength:integer);
  1609.   begin
  1610.     with ACanvas do begin
  1611.       if FRulerDirection=rdHorizontal then begin
  1612.         DrawLine(ACanvas, X, Y-4-TickLength, X, Y-4);
  1613.         DrawLine(ACanvas, X, Y+5, X, Y+5+TickLength);
  1614.       end
  1615.       else begin
  1616.         DrawLine(ACanvas, X-4-TickLength, Y, X-4, Y);
  1617.         DrawLine(ACanvas, X+5, Y, X+5+TickLength, Y);
  1618.       end;
  1619.     end;
  1620.   end; { DrawTick }
  1621.  
  1622. begin
  1623.   { Ruler, Ticks und Slider zeichnen }
  1624.   HalfSlidWidth:=FSliderWidth div 2;
  1625.   with ACanvas do begin
  1626.     { Ruler }
  1627.     Brush.Color:=FColors.Ruler;
  1628.     FillRect(ARect);
  1629.     DrawBevel(ACanvas, ARect, false, false);
  1630.     if FRulerDirection=rdHorizontal then begin
  1631.       HalfWidth:=(ARect.Bottom-ARect.Top) div 2;
  1632.       SWidth:=ARect.Bottom-ARect.Top-2;
  1633.       SRect.Left:=ARect.Left+HalfSlidWidth;
  1634.       SRect.Top:=ARect.Top+(SWidth div 2);
  1635.       SRect.Right:=ARect.Right-HalfSlidWidth;
  1636.       SRect.Bottom:=SRect.Top+3;
  1637.       SHeight:=SRect.Right-SRect.Left;
  1638.     end
  1639.     else begin
  1640.       HalfWidth:=(ARect.Right-ARect.Left) div 2;
  1641.       SWidth:=ARect.Right-ARect.Left-2;
  1642.       SRect.Left:=ARect.Left+(SWidth div 2);
  1643.       SRect.Top:=ARect.Top+HalfSlidWidth;
  1644.       SRect.Right:=SRect.Left+3;
  1645.       SRect.Bottom:=ARect.Bottom-HalfSlidWidth;
  1646.       SHeight:=SRect.Bottom-SRect.Top;
  1647.     end;
  1648.     DrawBevel(ACanvas, SRect, false, false);
  1649.     Pen.Color:=clBlack;
  1650.     InflateRect(SRect, -1, -1);
  1651.     Rectangle(SRect.Left, SRect.Top, SRect.Right, SRect.Bottom);
  1652.  
  1653.     { Ticks }
  1654.     if FTickStyle<>tsNone then begin
  1655.       { Long Ticks }
  1656.       Pen.Color:=FColors.TickMarks;
  1657.       Pen.Width:=2;
  1658.       TickLength:=HalfWidth-8;
  1659.       i:=GetSliderOffset(0);
  1660.       if FRulerDirection=rdHorizontal then begin
  1661.         DrawTick(SRect.Left, ARect.Top+HalfWidth, TickLength);
  1662.         if (FMinValue<>0) and (FMaxValue<>0) then
  1663.           DrawTick(SRect.Left+i, ARect.Top+HalfWidth, TickLength);
  1664.         DrawTick(SRect.Right, ARect.Top+HalfWidth, TickLength);
  1665.       end
  1666.       else begin
  1667.         DrawTick(ARect.Left+HalfWidth, SRect.Top, TickLength);
  1668.         if (FMinValue<>0) and (FMaxValue<>0) then
  1669.           DrawTick(ARect.Left+HalfWidth, SRect.Bottom-i, TickLength);
  1670.         DrawTick(ARect.Left+HalfWidth, SRect.Bottom, TickLength);
  1671.       end;
  1672.       Pen.Width:=1;
  1673.       if FTickStyle=tsAll then begin
  1674.         { Short Ticks }
  1675.         TickSpace:=SHeight/10;
  1676.         TickLength:=3;
  1677.         for i:=1 to 9 do begin
  1678.           if FRulerDirection=rdHorizontal then
  1679.             DrawTick(SRect.Left+round(i*TickSpace)-1, ARect.Top+HalfWidth, TickLength)
  1680.           else
  1681.             DrawTick(ARect.Left+HalfWidth, SRect.Top+round(i*TickSpace)-1, TickLength);
  1682.         end;
  1683.       end;
  1684.     end;
  1685.  
  1686.     if FFocusRect and Focused and DrawFocus then
  1687.       DoDrawFocusRect(ACanvas);
  1688.  
  1689.     { Slider }
  1690.     RulerPosition:=GetSliderOffset(FValue);
  1691.     if FRulerDirection=rdHorizontal then begin
  1692.       SRect.Left:=ARect.Left+RulerPosition+1;
  1693.       SRect.Top:=ARect.Top+1;
  1694.       SRect.Right:=SRect.Left+FSliderWidth;
  1695.       SRect.Bottom:=ARect.Bottom-1;
  1696.     end
  1697.     else begin
  1698.       SRect.Left:=ARect.Left+1;
  1699.       SRect.Top:=ARect.Bottom-RulerPosition-FSliderWidth-1;
  1700.       SRect.Right:=ARect.Right-1;
  1701.       SRect.Bottom:=SRect.Top+FSliderWidth;
  1702.     end;
  1703.     Brush.Color:=FColors.SliderTop;
  1704.     Pen.Color:=clBlack;
  1705.     Rectangle(SRect.Left, SRect.Top, SRect.Right, SRect.Bottom);
  1706.     InflateRect(SRect, -1, -1);
  1707.     DrawColorBevel(ACanvas, SRect, true, false, FColors.FBorderHL, FColors.FBorderSh);
  1708.     InflateRect(SRect, -1, -1);
  1709.     DrawColorBevel(ACanvas, SRect, true, false, FColors.FBorderHL, FColors.FBorderSh);
  1710.     Pen.Width:=2;
  1711.     Pen.Color:=FColors.SliderMark;
  1712.     if FRulerDirection=rdHorizontal then
  1713.       DrawLine(ACanvas, SRect.Left+(FSliderWidth div 2)-2, SRect.Top+1,
  1714.                         SRect.Left+(FSliderWidth div 2)-2, SRect.Bottom-1)
  1715.     else
  1716.       DrawLine(ACanvas, SRect.Left+1, SRect.Top+(FSliderWidth div 2)-2,
  1717.                         SRect.Right-1, SRect.Top+(FSliderWidth div 2)-2);
  1718.   end;
  1719. end;
  1720.  
  1721. function TSliderEdit.GetRulerLength:integer;
  1722. var Temp,
  1723.     CWidth : integer;
  1724.     CRect  : TRect;
  1725. begin
  1726.   CRect:=ClientRect;
  1727.   InflateRect(CRect, -FBevelWidth-FBorderWidth, -FBevelWidth-FBorderWidth);
  1728.   if FRulerDirection=rdHorizontal then begin
  1729.     CWidth:=(CRect.Right-CRect.Left);
  1730.     Temp:=CWidth-FDisplayWidth-(FDisplayWidth div 2)-4;
  1731.   end
  1732.   else begin
  1733.     CWidth:=(CRect.Bottom-CRect.Top);
  1734.     Temp:=CWidth-FDisplayHeight-(2*FSpinBtnHeight)-7;
  1735.   end;
  1736.   Result:=Temp-FSliderWidth-1;
  1737. end;
  1738.  
  1739. function TSliderEdit.GetSliderOffset(const AValue:integer):integer;
  1740. var Temp    : extended;
  1741.     ALength : integer;
  1742. begin
  1743.   if FMaxValue-FMinValue<>0 then begin
  1744.     ALength:=GetRulerLength;
  1745.     Temp:=ALength/(FMaxValue-FMinValue);
  1746.     Result:=round(Temp*(AValue-FMinValue));
  1747.   end
  1748.   else
  1749.     Result:=0;
  1750. end;
  1751.  
  1752. procedure TSliderEdit.KeyDown(var Key: Word; Shift: TShiftState);
  1753. begin
  1754.   if (Key=VK_Left) or (Key=VK_Down) then
  1755.     DoSpinBtnClick(true, Shift);
  1756.   if (Key=VK_Right) or (Key=VK_Up) then
  1757.     DoSpinBtnClick(false, Shift);
  1758.   if Key=VK_Prior then begin
  1759.     Include(Shift, ssShift);
  1760.     DoSpinBtnClick(false, Shift);
  1761.   end;
  1762.   if Key=VK_Next then begin
  1763.     Include(Shift, ssShift);
  1764.     DoSpinBtnClick(true, Shift);
  1765.   end;
  1766.   if Key=VK_Home then
  1767.     SetValue(FMinValue);
  1768.   if Key=VK_End then
  1769.     SetValue(FMaxValue);
  1770.   if Key=ord('0') then
  1771.     SetValue(0);
  1772.   if ((Key=VK_Escape) or (Key=VK_Return)) and assigned(FValueEdit) then
  1773.     FValueEdit.DestroySliderEdit;
  1774.  
  1775.   inherited KeyDown(Key, Shift);
  1776. end;
  1777.  
  1778. procedure TSliderEdit.KeyUp(var Key: Word; Shift: TShiftState);
  1779. begin
  1780.   FDownIndex:=-1;
  1781.   Invalidate;
  1782.  
  1783.   inherited KeyUp(Key, Shift);
  1784. end;
  1785.  
  1786. procedure TSliderEdit.Loaded;
  1787. begin
  1788.   inherited Loaded;
  1789.  
  1790.   if FMaxValue=FMinValue then begin
  1791.     if (FMaxValue=0) and (FMinValue=0) then begin
  1792.       SetMaxValue(127);
  1793.       SetMinValue(-128);
  1794.     end
  1795.     else
  1796.       SetMaxValue(FMinValue+1);
  1797.   end;
  1798. end;
  1799.  
  1800. procedure TSliderEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1801. var CRect,
  1802.     BRect     : TRect;
  1803.     CWidth    : integer;
  1804.     MoveMouse : boolean;
  1805. begin
  1806.   inherited MouseDown(Button, Shift, X, Y);
  1807.  
  1808.   MoveMouse:=true;
  1809.   FMouseDown:=true;
  1810.   SetFocus;
  1811.   CRect:=ClientRect;
  1812.   InflateRect(CRect, -FBevelWidth-FBorderWidth, -FBevelWidth-FBorderWidth);
  1813.  
  1814.   { SpinButton-Bereich ermitteln }
  1815.   if RulerDirection=rdHorizontal then begin
  1816.     CWidth:=FDisplayWidth;
  1817.     BRect:=Bounds(CRect.Right-FDisplayWidth, CRect.Bottom-FSpinBtnHeight, CWidth, FSpinBtnHeight);
  1818.   end
  1819.   else begin
  1820.     CWidth:=CRect.Right-CRect.Left;
  1821.     BRect:=Bounds(CRect.Left, CRect.Top+FDisplayHeight+2, CWidth, FSpinBtnHeight);
  1822.   end;
  1823.   if (X>BRect.Left) and (X<BRect.Right) and
  1824.    (Y>BRect.Top) and (Y<BRect.Bottom) then
  1825.     { Maus ist ⁿber den SpinButtons }
  1826.     DoSpinBtnClick(X>(BRect.Left+(CWidth div 2)), Shift);
  1827.   { Reset-Button-Bereich ermitteln }
  1828.   if RulerDirection=rdHorizontal then begin
  1829.     BRect:=Bounds(CRect.Left, CRect.Top, CWidth div 2, ResetBtnHeight);
  1830.     if (X>BRect.Left) and (X<BRect.Right) and
  1831.      (Y>BRect.Top) and (Y<BRect.Bottom) then begin
  1832.       { Maus ist ⁿber dem Reset-Button: FValue auf 0 setzen }
  1833.       FDownIndex:=2;
  1834.       SetValue(0);
  1835.     end;
  1836.     BRect:=Bounds(CRect.Left, CRect.Bottom-ResetBtnHeight, CWidth div 2, ResetBtnHeight);
  1837.     if (X>BRect.Left) and (X<BRect.Right) and
  1838.      (Y>BRect.Top) and (Y<BRect.Bottom) and assigned(FValueEdit) then begin
  1839.       { Maus ist ⁿber dem Close-Button: Control ausblenden }
  1840.       FValueEdit.DestroySliderEdit;
  1841.       MoveMouse:=false;
  1842.     end;
  1843.   end
  1844.   else begin
  1845.     BRect:=Bounds(CRect.Left, CRect.Bottom-ResetBtnHeight, CWidth, ResetBtnHeight);
  1846.     if (X>BRect.Left) and (X<BRect.Right) and
  1847.      (Y>BRect.Top) and (Y<BRect.Bottom) then begin
  1848.       { Maus ist ⁿber den Reset-Buttons }
  1849.       if X<(BRect.Left+(CWidth div 2)) then begin
  1850.         { Reset-Button: FValue auf 0 setzen }
  1851.         FDownIndex:=2;
  1852.         SetValue(0);
  1853.       end
  1854.       else begin
  1855.         { Close-Button: Control ausblenden }
  1856.         if assigned(FValueEdit) then begin
  1857.           FValueEdit.DestroySliderEdit;
  1858.           MoveMouse:=false;
  1859.         end;
  1860.       end;
  1861.     end;
  1862.   end;
  1863.  
  1864.   if MoveMouse and not FAutoHide and (ssLeft in Shift) then
  1865.     { Sliderposition setzen }
  1866.     MouseMove(Shift, X, Y);
  1867. end;
  1868.  
  1869. procedure TSliderEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
  1870. var MousePos,
  1871.     RulerLen : integer;
  1872.     Temp     : extended;
  1873. begin
  1874.   if ssLeft in Shift then begin
  1875.     RulerLen:=GetRulerLength;
  1876.     if FRulerDirection=rdHorizontal then
  1877.       MousePos:=X-(FDisplayWidth div 2)-6-(FSliderWidth div 2)
  1878.     else
  1879.       MousePos:=Height-Y-FSpinBtnHeight-7-(FSliderWidth div 2);
  1880.     if (MousePos>=0) and (MousePos<=RulerLen) and (FMaxValue-FMinValue<>0) then begin
  1881.       Temp:=MousePos/RulerLen;
  1882.       SetValue(round(Temp*(FMaxValue-FMinValue))+FMinValue);
  1883.     end;
  1884.   end;
  1885.  
  1886.   inherited MouseMove(Shift, X, Y);
  1887. end;
  1888.  
  1889. procedure TSliderEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1890. begin
  1891.   inherited MouseUp(Button, Shift, X, Y);
  1892.  
  1893.   FMouseDown:=false;
  1894.   if FAutoHide and assigned(FValueEdit) then
  1895.     FValueEdit.DestroySliderEdit;
  1896.   if not FAutoHide then begin
  1897.     FDownIndex:=-1;
  1898.     Invalidate;
  1899.   end;
  1900. end;
  1901.  
  1902. procedure TSliderEdit.Paint;
  1903. var CRect,
  1904.     ARect : TRect;
  1905.     i     : integer;
  1906. begin
  1907.   CRect:=ClientRect;
  1908.   with FDrawBuffer.Canvas do begin
  1909.     { Bevel }
  1910.     Pen.Width:=1;
  1911.     if FBevelStyle<>bvNone then begin
  1912.       {$IFDEF SR_Delphi5_Up}
  1913.       if FBevelStyle<>bvSpace then begin
  1914.       {$ENDIF}
  1915.         for i:=1 to FBevelWidth do begin
  1916.           if FBevelStyle=bvRaised then
  1917.             DrawBevel(FDrawBuffer.Canvas, CRect, true, false);
  1918.           if FBevelStyle=bvLowered then
  1919.             DrawBevel(FDrawBuffer.Canvas, CRect, false, false);
  1920.           InflateRect(CRect, -1, -1);
  1921.         end;
  1922.       {$IFDEF SR_Delphi5_Up}
  1923.       end;
  1924.       {$ENDIF}
  1925.     end;
  1926.  
  1927.     { Hintergrund }
  1928.     Brush.Color:=FColors.Background;
  1929.     FillRect(CRect);
  1930.     InflateRect(CRect, -FBorderWidth, -FBorderWidth);
  1931.  
  1932.     { Wertanzeige und SpinButtons }
  1933.     ARect:=CRect;
  1934.     if FRulerDirection=rdHorizontal then begin
  1935.       ARect.Left:=ARect.Right-FDisplayWidth;
  1936.       CRect.Right:=ARect.Left-2;
  1937.     end
  1938.     else begin
  1939.       ARect.Bottom:=FDisplayHeight+FSpinBtnHeight+4;
  1940.       CRect.Top:=ARect.Bottom+2;
  1941.     end;
  1942.     DrawValueDisplay(FDrawBuffer.Canvas, ARect);
  1943.  
  1944.     { Reset- und Close-Buttons }
  1945.     ARect:=CRect;
  1946.     if FRulerDirection=rdHorizontal then begin
  1947.       ARect.Right:=ARect.Left+ResetBtnWidth;
  1948.       CRect.Left:=ARect.Right+2;
  1949.     end
  1950.     else begin
  1951.       ARect.Top:=ARect.Bottom-ResetBtnHeight;
  1952.       CRect.Bottom:=ARect.Top-1;
  1953.     end;
  1954.     DrawResetButtons(FDrawBuffer.Canvas, ARect);
  1955.  
  1956.     { Slider }
  1957.     DrawRuler(FDrawBuffer.Canvas, CRect, not FMouseDown);
  1958.   end;
  1959.  
  1960.   Canvas.Draw(0, 0, FDrawBuffer);
  1961. end;
  1962.  
  1963. procedure TSliderEdit.SetBevelStyle(newValue: TPanelBevel);
  1964. begin
  1965.   if NewValue<>FBevelStyle then begin
  1966.     FBevelStyle:=NewValue;
  1967.     GetRulerLength;
  1968.     Invalidate;
  1969.   end;
  1970. end;
  1971.  
  1972. procedure TSliderEdit.SetBevelWidth(newValue: integer);
  1973. begin
  1974.   if NewValue<>FBevelWidth then begin
  1975.     FBevelWidth:=NewValue;
  1976.     GetRulerLength;
  1977.     Invalidate;
  1978.   end;
  1979. end;
  1980.  
  1981. procedure TSliderEdit.SetBorderWidth(newValue: integer);
  1982. begin
  1983.   if NewValue<>FBorderWidth then begin
  1984.     FBorderWidth:=NewValue;
  1985.     GetRulerLength;
  1986.     Invalidate;
  1987.   end;
  1988. end;
  1989.  
  1990. procedure TSliderEdit.SetColors(newValue: TColors);
  1991. begin
  1992.   with FColors do begin
  1993.     Background:=newValue.Background;
  1994.     NumBackground:=newValue.NumBackground;
  1995.     NumFrame:=newValue.NumFrame;
  1996.     SliderBorder:=newValue.SliderBorder;
  1997.     SliderTop:=newValue.SliderTop;
  1998.     SliderMark:=newValue.SliderMark;
  1999.     TickMarks:=newValue.TickMarks;
  2000.   end;
  2001.   Invalidate;
  2002. end;
  2003.  
  2004. procedure TSliderEdit.SetDisplayWidth(newValue: integer);
  2005. begin
  2006.   if NewValue<>FDisplayWidth then begin
  2007.     FDisplayWidth:=NewValue;
  2008.     if FRulerDirection=rdHorizontal then begin
  2009.       GetRulerLength;
  2010.       Invalidate;
  2011.     end;
  2012.   end;
  2013. end;
  2014.  
  2015. procedure TSliderEdit.SetFocusRect(newValue: boolean);
  2016. begin
  2017.   if NewValue<>FFocusRect then begin
  2018.     FFocusRect:=NewValue;
  2019.     if Focused then
  2020.       Invalidate;
  2021.   end;
  2022. end;
  2023.  
  2024. procedure TSliderEdit.SetMaxValue(newValue: integer);
  2025. begin
  2026.   if NewValue<>FMaxValue then begin
  2027.     FMaxValue:=NewValue;
  2028.     if FValue>FMaxValue then
  2029.       SetValue(FMaxValue);
  2030.   end;
  2031. end;
  2032.  
  2033. procedure TSliderEdit.SetMinValue(newValue: integer);
  2034. begin
  2035.   if NewValue<>FMinValue then begin
  2036.     FMinValue:=NewValue;
  2037.     if FValue<FMinValue then
  2038.       SetValue(FMinValue);
  2039.   end;
  2040. end;
  2041.  
  2042. procedure TSliderEdit.SetSliderWidth(newValue: integer);
  2043. begin
  2044.   if newValue<>FSliderWidth then begin
  2045.     FSliderWidth:=newValue;
  2046.     GetRulerLength;
  2047.     Invalidate;
  2048.   end;
  2049. end;
  2050.  
  2051. procedure TSliderEdit.SetRulerDirection(newValue: TRulerDirection);
  2052. var OldSize : integer;
  2053. begin
  2054.   if newValue<>FRulerDirection then begin
  2055.     FRulerDirection:=newValue;
  2056.     if not (csReading in ComponentState) then begin
  2057.       OldSize:=Width;
  2058.       Width:=Height;
  2059.       Height:=OldSize;
  2060.       Invalidate;
  2061.     end;
  2062.   end;
  2063. end;
  2064.  
  2065. procedure TSliderEdit.SetSpinBtnHeight(newValue: integer);
  2066. begin
  2067.   if NewValue<>FSpinBtnHeight then begin
  2068.     FSpinBtnHeight:=NewValue;
  2069.     GetRulerLength;
  2070.     Invalidate;
  2071.   end;
  2072. end;
  2073.  
  2074. procedure TSliderEdit.SetTickStyle(newValue: TTickStyle);
  2075. begin
  2076.   if NewValue<>FTickStyle then begin
  2077.     FTickStyle:=NewValue;
  2078.     Invalidate;
  2079.   end;
  2080. end;
  2081.  
  2082. procedure TSliderEdit.SetValue(NewValue: integer);
  2083. begin
  2084.   if newValue<>FValue then begin
  2085.     if NewValue<FMinValue then
  2086.       NewValue:=FMinValue;
  2087.     if NewValue>FMaxValue then
  2088.       NewValue:=FMaxValue;
  2089.     FValue:=NewValue;
  2090.     Invalidate;
  2091.     if assigned(FValueEdit) then
  2092.       FValueEdit.SetValue(FValue);
  2093.   end;
  2094. end;
  2095.  
  2096. procedure TSliderEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2097. begin
  2098.   Message.Result := 1;
  2099. end;
  2100.  
  2101. procedure TSliderEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  2102. begin
  2103.   inherited;
  2104.   { Kein Fokuswechsel durch Cursortasten }
  2105.   Message.Result:=Message.Result or DLGC_WANTARROWS;
  2106. end;
  2107.  
  2108. procedure TSliderEdit.WMKillFocus(var Message: TWMKillFocus);
  2109. begin
  2110.   inherited;
  2111.  
  2112.   if FHasFocus and assigned(FValueEdit) then
  2113.     FValueEdit.DestroySliderEdit
  2114.   else
  2115.     Invalidate;
  2116.   FHasFocus:=false;
  2117. end;
  2118.  
  2119. procedure TSliderEdit.WMSetFocus(var Message: TWMSetFocus);
  2120. begin
  2121.   inherited;
  2122.  
  2123.   FHasFocus:=true;
  2124.   Invalidate;
  2125. end;
  2126.  
  2127. procedure TSliderEdit.WMSize(var Message: TWMSize);
  2128. begin
  2129.   inherited;
  2130.  
  2131.   FDrawBuffer.Width:=Width;
  2132.   FDrawBuffer.Height:=Height;
  2133.   GetRulerlength;
  2134.   Message.Result := 0;
  2135. end;
  2136.  
  2137.  
  2138. { TSRValueEdit }
  2139.  
  2140. constructor TSRValueEdit.Create(AOwner: TComponent);
  2141. var i : byte;
  2142. begin
  2143.   inherited Create(AOwner);
  2144.  
  2145.   Randomize;
  2146.   Width:=60;
  2147.   Height:=100;
  2148.  
  2149.   FNumericEdit:=TNumericEdit.Create(Self);
  2150.   FNumericEdit.Parent:=Self;
  2151.   FNumericEdit.FValueEdit:=Self;
  2152.   FNumericEdit.Left:=FNumEditOffset;
  2153.   FNumericEdit.Top:=FNumEditOffset;
  2154.   FNumericEdit.Width:=Self.Width-(2*FNumEditOffset);
  2155.  
  2156.   Font.Color:=clLime;
  2157.   Font.Style:=[fsBold];
  2158.  
  2159.   FColors := TColors.Create(Self);
  2160.  
  2161.   FBevelStyle:=bvRaised;
  2162.   FBevelWidth:=1;
  2163.   FBorderWidth:=4;
  2164.   FCaptureMouse:=true;
  2165.   FDecSeparator:='.';
  2166.   FFocusRect:=false;
  2167.   if csDesigning in ComponentState then begin
  2168.     FNumDigits:=4;
  2169.     FDecSeparatorPos:=2;
  2170.     FMaxValue:=99.99;
  2171.     FMinValue:=-99.99;
  2172.   end;
  2173.   for i:=0 to 4 do
  2174.     FScrewPos[i]:=Random(4);
  2175.   FScrewSize:=8;
  2176.   FShowScrews:=false;
  2177.   FRulerDirection:=rdVertical;
  2178.   FSliderEditLength:=DefaultRulerLength;
  2179.   FSliderEditWidth:=DefaultRulerWidth;
  2180.   FSliderWidth:=DefaultThumbWidth;
  2181.   FSpinBtnHeight:=10;
  2182.   FSpinControlWidth:=25;
  2183.   FTickStyle:=tsAll;
  2184.   FValue:=0;
  2185.   FValueHistory:=true;
  2186.   CalcBorderWidth;
  2187.  
  2188. end;
  2189.  
  2190. destructor TSRValueEdit.Destroy;
  2191. var i : integer;
  2192. begin
  2193.   if assigned(FColors) then
  2194.     FreeAndNil(FColors);
  2195.  
  2196.   if assigned(FNumericEdit) then
  2197.     FreeAndNil(FNumericEdit);
  2198.  
  2199.   if assigned(FHistoryMenu) then begin
  2200.     for i:=FHistoryMenu.Items.Count-1 downto 0 do
  2201.       FHistoryMenu.Items[i].Free;
  2202.     FreeAndNil(FHistoryMenu);
  2203.   end;
  2204.  
  2205.   DestroySliderEdit;
  2206.  
  2207.   inherited Destroy;
  2208. end;
  2209.  
  2210. procedure TSRValueEdit.AddHistoryItem(ValueNr:byte);
  2211. var NewItem : TMenuItem;
  2212. begin
  2213.   if (trunc(FHistoryValue[ValueNr]*10000)<>trunc(FValue*10000)) and assigned(FHistoryMenu) then begin
  2214.     NewItem:=TMenuItem.Create(Self);
  2215.     with NewItem do begin
  2216.       Caption:=FloatToStrF(FHistoryValue[ValueNr], ffNumber, 15, FDecSeparatorPos);
  2217.       Tag:=ValueNr;
  2218.       OnClick:=HistoryItemClick;
  2219.     end;
  2220.     FHistoryMenu.Items.Insert(0, NewItem);
  2221.   end;
  2222. end;
  2223.  
  2224. procedure TSRValueEdit.AddValueToHistory(AValue:extended);
  2225. var i : byte;
  2226.  
  2227.   function ValueExists(AValue:extended):boolean;
  2228.   var i : byte;
  2229.   begin
  2230.     Result:=false;
  2231.     if FHistoryCount>0 then
  2232.       for i:=0 to FHistoryCount-1 do
  2233.         if (trunc(FHistoryValue[i]*10000)=trunc(AValue*10000)) then
  2234.           Result:=true;
  2235.   end; {ValueExists}
  2236.  
  2237. begin
  2238.   if not ValueExists(AValue) then begin
  2239.     if FHistoryCount<MaxHistoryItems then begin
  2240.       FHistoryValue[FHistoryCount]:=AValue;
  2241.       FHistoryCount:=FHistoryCount+1;
  2242.     end
  2243.     else begin
  2244.       for i:=0 to MaxHistoryItems-2 do
  2245.         FHistoryValue[i]:=FHistoryValue[i+1];
  2246.       FHistoryValue[MaxHistoryItems-1]:=AValue;
  2247.     end;
  2248.   end;
  2249. end;
  2250.  
  2251. procedure TSRValueEdit.CalcBorderWidth;
  2252. begin
  2253.   FOldOffset:=FNumEditOffset;
  2254.   if FShowScrews then
  2255.     FNumEditOffset:=ScrewSize
  2256.   else
  2257.     FNumEditOffset:=0;
  2258.   if FBevelStyle<>bvNone then
  2259.     FNumEditOffset:=FNumEditOffset+FBevelWidth;
  2260.   FNumEditOffset:=FNumEditOffset+FBorderWidth;
  2261.   if assigned(FNumericEdit) and (FOldOffset<>FNumEditOffset) then
  2262.     SetControlsPosAndWidth;
  2263. end;
  2264.  
  2265. procedure TSRValueEdit.Change;
  2266. begin
  2267.   FOldvalue:=FValue;
  2268.   if Assigned(FOnChange) then
  2269.     FOnChange(Self);
  2270. end;
  2271.  
  2272. procedure TSRValueEdit.CMFontChanged(var Message: TMessage);
  2273. begin
  2274.   inherited;
  2275.   if assigned(FNumericEdit) then
  2276.     FNumericEdit.Font.Assign(Self.Font);
  2277. end;
  2278.  
  2279. procedure TSRValueEdit.DestroySliderEdit;
  2280. begin
  2281.   if assigned(FSliderEdit) then begin
  2282.     FreeAndNil(FSliderEdit);
  2283.     if assigned(FOnHideSlider) then
  2284.       FOnHideSlider(Self);
  2285.   end;
  2286.   if FCaptureMouse then
  2287.     ClipCursor(nil);
  2288.   if FValueHistory then
  2289.     AddValueToHistory(FValue);
  2290.   if assigned(FNumericEdit) then
  2291.     FNumericEdit.SetFocus;
  2292. end;
  2293.  
  2294. procedure TSRValueEdit.DoDrawFocusRect(IsFocused:boolean);
  2295. var CRect : TRect;
  2296. begin
  2297.   CRect:=ClientRect;
  2298.   InflateRect(CRect, -FNumEditOffset, -FNumEditOffset);
  2299.   if assigned(FNumericEdit) then
  2300.     CRect.Top:=FNumericEdit.Top+FNumericEdit.Height+4;
  2301.   if IsFocused then begin
  2302.     Canvas.Brush.Color:=clBlack;
  2303.     Canvas.Pen.Color:=clBlack;
  2304.     DrawDotLine(Canvas, CRect.Left+1, CRect.Top, CRect.Right-CRect.Left-2, true);
  2305.     DrawDotLine(Canvas, CRect.Right-1, CRect.Top+1, CRect.Bottom-CRect.Top-2, false);
  2306.     DrawDotLine(Canvas, CRect.Left+1, CRect.Bottom-1, CRect.Right-CRect.Left-2, true);
  2307.     DrawDotLine(Canvas, CRect.Left, CRect.Top+1, CRect.Bottom-CRect.Top-2, false);
  2308.   end
  2309.   else begin
  2310.     Canvas.Brush.Color:=FColors.Background;
  2311.     Canvas.FrameRect(CRect);
  2312.   end;
  2313. end;
  2314.  
  2315. procedure TSRValueEdit.DoSpinBtnClick(BtnIndex:integer;UpBtn:boolean);
  2316. begin
  2317.   if assigned(FOnSpinBtnClick) then
  2318.     FOnSpinBtnClick(Self, BtnIndex, UpBtn);
  2319. end;
  2320.  
  2321. procedure TSRValueEdit.DrawRadioControl(IsFocused:boolean);
  2322. var ARect,
  2323.     CRect   : TRect;
  2324.     Center  : TPoint;
  2325.     i,Angle : integer;
  2326.     Temp    : double;
  2327. begin
  2328.   CRect:=ClientRect;
  2329.   if assigned(FNumericEdit) then
  2330.     InflateRect(CRect, -FNumEditOffset, -FNumEditOffset);
  2331.   ARect:=GetSpinControlRect(CRect, true);
  2332.   with Canvas do begin
  2333.     { Border }
  2334.     if FocusRect and Focused then
  2335.       DoDrawFocusRect(true);
  2336.     Brush.Color:=clBlack;
  2337.     Pen.Color:=clBlack;
  2338.     Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  2339.     InflateRect(ARect, -2, -2);
  2340.     { Bevel }
  2341.     Pen.Width:=2;
  2342.     Pen.Color:=FColors.FBorderSh;
  2343.     Arc(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
  2344.         ARect.Left, ARect.Bottom, ARect.Right, ARect.Top);
  2345.     Pen.Color:=FColors.FBorderHL;
  2346.     Arc(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
  2347.         ARect.Right, ARect.Top, ARect.Left, ARect.Bottom);
  2348.     { Top }
  2349.     InflateRect(ARect, -1, -1);
  2350.     Pen.Width:=1;
  2351.     Pen.Color:=clBlack;
  2352.     Brush.Color:=FColors.SliderTop;
  2353.     Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  2354.     { Mark }
  2355.     Center.X:=ARect.Left+(ARect.Right-ARect.Left) div 2;
  2356.     Center.Y:=ARect.Top+(ARect.Bottom-ARect.Top) div 2;
  2357.     if FMaxValue-FMinValue<>0 then begin
  2358.       Temp:=240/(FMaxValue-FMinValue);
  2359.       Angle:=round(Temp*(FValue-FMinValue));
  2360.     end
  2361.     else
  2362.       Angle:=0;
  2363.     Pen.Color:=FColors.SliderMark;
  2364.     Pen.Width:=2;
  2365.     MoveTo(Center.X, Center.Y);
  2366.     LineTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+2, 120-Angle),
  2367.            YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+2, 120-Angle));
  2368.     { Ticks }
  2369.     if FTickStyle<>tsNone then begin
  2370.       Pen.Color:=FColors.TickMarks;
  2371.       Pen.Width:=2;
  2372.       for i:=0 to 2 do begin
  2373.         MoveTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+5, 120+(i*120)),
  2374.                YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+5, 120+(i*120)));
  2375.         LineTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+10, 120+(i*120)),
  2376.                YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+10, 120+(i*120)));
  2377.       end;
  2378.       if FTickStyle=tsAll then begin
  2379.         Pen.Width:=1;
  2380.         for i:=0 to 5 do begin
  2381.           MoveTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+5, 240+(i*24)),
  2382.                  YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+5, 240+(i*24)));
  2383.           LineTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+10, 240+(i*24)),
  2384.                  YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+10, 240+(i*24)));
  2385.           MoveTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+5, 120-(i*24)),
  2386.                  YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+5, 120-(i*24)));
  2387.           LineTo(XKoord(Center.X, ((ARect.Right-ARect.Left) div 2)+10, 120-(i*24)),
  2388.                  YKoord(Center.Y, ((ARect.Bottom-ARect.Top) div 2)+10, 120-(i*24)));
  2389.         end;
  2390.       end;
  2391.     end;
  2392.   end;
  2393. end;
  2394.  
  2395. procedure TSRValueEdit.DrawScrew(X,Y,Nr:integer);
  2396. var ScrewRegion : HRgn;
  2397. begin
  2398.   with Canvas do begin
  2399.     Pen.Width:=1;
  2400.     { Au▀enrand }
  2401.     Pen.Color:=clBtnShadow;
  2402.     Brush.Color:=clSilver;
  2403.     Ellipse(X, Y, X+FScrewSize, Y+FScrewSize);
  2404.     Arc(X,Y,X+FScrewSize,Y+FScrewSize,
  2405.         X+((FScrewSize div 4)*3), Y+(FScrewSize div 4),
  2406.         X+(FScrewSize div 4), Y+((FScrewSize div 4)*3));
  2407.     Pen.Color:=clBtnHighlight;
  2408.     Arc(X, Y, X+FScrewSize, Y+FScrewSize,
  2409.         X+(FScrewSize div 4), Y+((FScrewSize div 4)*3),
  2410.         X+((FScrewSize div 4)*3), Y+(FScrewSize div 4));
  2411.     Pen.Color:=clBlack;
  2412.   end;
  2413.   { Schlitz }
  2414.   ScrewRegion:=CreateEllipticRgn(X+1, Y+1, X+FScrewSize-1, Y+FScrewSize-1);
  2415.   try
  2416.     SelectClipRgn(Canvas.Handle, ScrewRegion);
  2417.     Canvas.Pen.Color:=clBtnShadow;
  2418.     case Nr of
  2419.       0 : DrawLine(Canvas, X, Y, X+FScrewSize, Y+FScrewSize);
  2420.       1 : DrawLine(Canvas, X, Y+FScrewSize-1, X+FScrewSize, Y-1);
  2421.       2 : DrawLine(Canvas, X, Y+(FScrewSize div 2)-1, X+FScrewSize, Y+(FScrewSize div 2)-1);
  2422.       3 : DrawLine(Canvas, X+(FScrewSize div 2)-1, Y, X+(FScrewSize div 2)-1, Y+FScrewSize);
  2423.     end;
  2424.     Canvas.Pen.Color:=clBtnHighlight;
  2425.     case Nr of
  2426.       0 : DrawLine(Canvas, X, Y+1, X+FScrewSize, Y+1+FScrewSize);
  2427.       1 : DrawLine(Canvas, X, Y+FScrewSize, X+FScrewSize, Y);
  2428.       2 : DrawLine(Canvas, X+1, Y+(FScrewSize div 2), X+1+FScrewSize, Y+(FScrewSize div 2));
  2429.       3 : DrawLine(Canvas, X+(FScrewSize div 2), Y, X+(FScrewSize div 2), Y+FScrewSize);
  2430.     end;
  2431.   finally
  2432.     DeleteObject(ScrewRegion);
  2433.     SelectClipRgn(Canvas.Handle, 0);
  2434.   end;
  2435. end;
  2436.  
  2437. function TSRValueEdit.GetSpinControlRect(CRect:TRect;IsClientRect:boolean):TRect;
  2438. var CWidth,
  2439.     CHeight : integer;
  2440. begin
  2441.   if IsClientRect and assigned(FNumericEdit) then begin
  2442.     InflateRect(CRect, -FNumEditOffset, -FNumEditOffset);
  2443.     CRect.Top:=FNumericEdit.Top+FNumericEdit.Height+4;
  2444.   end;
  2445.   CWidth:=CRect.Right-CRect.Left;
  2446.   CHeight:=CRect.Bottom-CRect.Top;
  2447.   with Result do begin
  2448.     Left:=CRect.Left+((CWidth-FSpinControlWidth) div 2);
  2449.     Top:=CRect.Top+((CHeight-FSpinControlWidth) div 2)+4;
  2450.     Right:=Left+FSpinControlWidth;
  2451.     Bottom:=Top+FSpinControlWidth;
  2452.   end;
  2453. end;
  2454.  
  2455. function TSRValueEdit.IsInsideSpinControl(X,Y: Integer):boolean;
  2456. var BtnEllipse : HRgn;
  2457.     ARect      : TRect;
  2458. begin
  2459.   { Ist die Maus ⁿber dem Drehknopf? }
  2460.   ARect:=GetSpinControlRect(ClientRect, true);
  2461.   BtnEllipse:=CreateEllipticRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  2462.   Result:=PtInRegion(BtnEllipse, X, Y);
  2463.   DeleteObject(BtnEllipse);
  2464. end;
  2465.  
  2466. procedure TSRValueEdit.HistoryItemClick(Sender: TObject);
  2467. var ValueNr : integer;
  2468. begin
  2469.   ValueNr:=(Sender as TMenuItem).Tag;
  2470.   if (ValueNr>=0) and (ValueNr<FHistoryCount) then
  2471.     SetValue(FHistoryValue[ValueNr]);
  2472.     
  2473.   if assigned(FOnHistoryClick) then
  2474.     FOnHistoryClick(Self);
  2475. end;
  2476.  
  2477. procedure TSRValueEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2478. var MenuPos : TPoint;
  2479.     i       : integer;
  2480.     OnSpin  : boolean;
  2481. begin
  2482.   OnSpin:=IsInsideSpinControl(X, Y);
  2483.   if Enabled and not assigned(FSliderEdit) and
  2484.    assigned(FNumericEdit) and not OnSpin then
  2485.     FNumericEdit.SetFocus;
  2486.  
  2487.   if Enabled and not assigned(FSliderEdit) and
  2488.    (Owner is TForm) and (Button=mbLeft) and OnSpin then
  2489.       ShowSliderEdit(not (ssShift in Shift))
  2490.   else
  2491.     inherited MouseDown(Button, Shift, X, Y);
  2492.  
  2493.   if FValueHistory and (Button=mbRight) and (PopupMenu=nil) then begin
  2494.     { Value-History als PopupMenu anzeigen }
  2495.     FHistoryMenu:=TPopupMenu.Create(Self);
  2496.     for i:=0 to FHistoryCount-1 do
  2497.       AddHistoryItem(i);
  2498.     MenuPos:=ClientToScreen(Point(X, Y));
  2499.     with FHistoryMenu do begin
  2500.       Alignment:=paRight;
  2501.       {$IFDEF SR_Delphi5_Up}
  2502.       AutoHotkeys:=maManual;
  2503.       {$ENDIF}
  2504.       Popup(MenuPos.X, MenuPos.Y);
  2505.     end;
  2506.   end;
  2507. end;
  2508.  
  2509. procedure TSRValueEdit.Paint;
  2510. var ARect,
  2511.     BRect : TRect;
  2512.     i     : integer;
  2513. begin
  2514.   inherited Paint;
  2515.  
  2516.   ARect:=ClientRect;
  2517.   { Rahmen }
  2518.   if FBevelStyle<>bvNone then begin
  2519.     {$IFDEF SR_Delphi5_Up}
  2520.     if FBevelStyle<>bvSpace then begin
  2521.     {$ENDIF}
  2522.       BRect:=ARect;
  2523.       for i:=1 to FBevelWidth do begin
  2524.         if FBevelStyle=bvRaised then
  2525.           DrawBevel(Canvas, BRect, true, false);
  2526.         if FBevelStyle=bvLowered then
  2527.           DrawBevel(Canvas, BRect, false, false);
  2528.         InflateRect(BRect, -1, -1);
  2529.       end;
  2530.     {$IFDEF SR_Delphi5_Up}
  2531.     end;
  2532.     {$ENDIF}
  2533.     InflateRect(ARect, -BevelWidth, -BevelWidth);
  2534.   end;
  2535.  
  2536.   { Hintergrund }
  2537.   with Canvas do begin
  2538.     Brush.Color:=FColors.Background;
  2539.     FillRect(ARect);
  2540.   end;
  2541.  
  2542.   { Schrauben }
  2543.   if FShowScrews then begin
  2544.     DrawScrew(ARect.Left+1, ARect.Top+1, 0);
  2545.     DrawScrew(ARect.Right-FScrewSize-1, ARect.Top+1, 1);
  2546.     DrawScrew(ARect.Left+1, ARect.Bottom-FScrewSize-1, 2);
  2547.     DrawScrew(ARect.Right-FScrewSize-1, ARect.Bottom-FScrewSize-1, 3);
  2548.   end;
  2549.  
  2550.   { RadioControl }
  2551.   DrawRadioControl(Focused);
  2552.   
  2553.   { NumericEdit }
  2554.   if assigned(FNumericEdit) then
  2555.     FNumericEdit.Paint;
  2556. end;
  2557.  
  2558. procedure TSRValueEdit.SetBevelStyle(newValue: TPanelBevel);
  2559. begin
  2560.   if NewValue<>FBevelStyle then begin
  2561.     FBevelStyle:=NewValue;
  2562.     CalcBorderWidth;
  2563.     Invalidate;
  2564.   end;
  2565. end;
  2566.  
  2567. procedure TSRValueEdit.SetBevelWidth(newValue: integer);
  2568. begin
  2569.   if NewValue<>FBevelWidth then begin
  2570.     FBevelWidth:=NewValue;
  2571.     CalcBorderWidth;
  2572.     Invalidate;
  2573.   end;
  2574. end;
  2575.  
  2576. procedure TSRValueEdit.SetBorderWidth(newValue: integer);
  2577. begin
  2578.   if NewValue<>FBorderWidth then begin
  2579.     FBorderWidth:=NewValue;
  2580.     CalcBorderWidth;
  2581.     Invalidate;
  2582.   end;
  2583. end;
  2584.  
  2585. procedure TSRValueEdit.SetColors(newValue: TColors);
  2586. begin
  2587.   with FColors do begin
  2588.     Background:=newValue.Background;
  2589.     NumBackground:=newValue.NumBackground;
  2590.     NumFrame:=newValue.NumFrame;
  2591.     SliderBorder:=newValue.SliderBorder;
  2592.     SliderTop:=newValue.SliderTop;
  2593.     SliderMark:=newValue.SliderMark;
  2594.     TickMarks:=newValue.TickMarks;
  2595.   end;
  2596.   if assigned(FNumericEdit) then begin
  2597.     FNumericEdit.SetColor(FColors.NumBackground);
  2598.     FNumericEdit.SetFrameColor(FColors.NumFrame);
  2599.   end;
  2600.   Invalidate;
  2601. end;
  2602.  
  2603. procedure TSRValueEdit.SetControlsPosAndWidth;
  2604. var AWidth : integer;
  2605. begin
  2606.   if assigned(FNumericEdit) then begin
  2607.     AWidth:=(Width-(2*FNumEditOffset)) div (FNumericEdit.FNumDigits+1);
  2608.     FNumericEdit.Width:=AWidth*(FNumericEdit.FNumDigits+1)+2;
  2609.     FNumericEdit.Left:=FNumEditOffset+((Width div 2)-FNumEditOffset-(FNumericEdit.Width div 2));
  2610.     FNumericEdit.Top:=FNumEditOffset;
  2611.   end;
  2612. end;
  2613.  
  2614. procedure TSRValueEdit.SetDecSeparator(newValue: char);
  2615. begin
  2616.   if NewValue<>FDecSeparator then begin
  2617.     FDecSeparator:=NewValue;
  2618.     if assigned(FNumericEdit) then
  2619.       FNumericEdit.DecSeparator:=NewValue;
  2620.   end;
  2621. end;
  2622.  
  2623. procedure TSRValueEdit.SetDecSeparatorPos(newValue: byte);
  2624. var NumMax : extended;
  2625. begin
  2626.   if NewValue<>FDecSeparatorPos then begin
  2627.     FDecSeparatorPos:=NewValue;
  2628.     if assigned(FNumericEdit) then begin
  2629.       FNumericEdit.SetDecSeparatorPos(NewValue);
  2630.       NumMax:=FNumericEdit.GetMaxValue;
  2631.       if FMaxValue>NumMax then
  2632.         FMaxValue:=NumMax;
  2633.       if abs(FMinValue)>NumMax then
  2634.         FMinValue:=-NumMax;
  2635.     end;
  2636.   end;
  2637. end;
  2638.  
  2639. procedure TSRValueEdit.SetFocusRect(newValue: boolean);
  2640. begin
  2641.   if NewValue<>FFocusRect then begin
  2642.     FFocusRect:=NewValue;
  2643.     Invalidate;
  2644.   end;
  2645. end;
  2646.  
  2647. procedure TSRValueEdit.SetMaxValue(newValue: extended);
  2648. var NumMax : extended;
  2649. begin
  2650.   if NewValue<>FMaxValue then begin
  2651.     if NewValue<=FMinValue then
  2652.       FMaxValue:=FMinValue+1
  2653.     else begin
  2654.       if assigned(FNumericEdit) then begin
  2655.         NumMax:=FNumericEdit.GetMaxValue;
  2656.         if abs(NewValue)>NumMax then
  2657.           FMaxValue:=NumMax
  2658.         else
  2659.           FMaxValue:=NewValue;
  2660.       end
  2661.       else
  2662.         FMaxValue:=NewValue;
  2663.     end;
  2664.     if FValue>FMaxValue then
  2665.       SetValue(FMaxValue);
  2666.     if assigned(FNumericEdit) then
  2667.       FNumericEdit.SetMaxValue(FMaxValue);
  2668.   end;
  2669. end;
  2670.  
  2671. procedure TSRValueEdit.SetMinValue(newValue: extended);
  2672. var NumMax : extended;
  2673. begin
  2674.   if NewValue<>FMinValue then begin
  2675.     if NewValue>=FMaxValue then
  2676.       FMinValue:=FMaxValue-1
  2677.     else begin
  2678.       if assigned(FNumericEdit) then begin
  2679.         NumMax:=FNumericEdit.GetMaxValue;
  2680.         if abs(NewValue)>NumMax then
  2681.           FMinValue:=-NumMax
  2682.         else
  2683.           FMinValue:=NewValue;
  2684.       end
  2685.       else
  2686.         FMinValue:=NewValue;
  2687.     end;
  2688.     if FValue<FMinValue then
  2689.       SetValue(FMinValue);
  2690.     if assigned(FNumericEdit) then
  2691.       FNumericEdit.SetMinValue(FMinValue);
  2692.   end;
  2693. end;
  2694.  
  2695. procedure TSRValueEdit.SetNumDigits(newValue: TNumDigits);
  2696. begin
  2697.   if NewValue<>FNumDigits then begin
  2698.     FNumDigits:=NewValue;
  2699.     if assigned(FNumericEdit) then begin
  2700.       FNumericEdit.NumDigits:=NewValue;
  2701.       SetControlsPosAndWidth;
  2702.       FNumericEdit.Invalidate;
  2703.     end;
  2704.   end;
  2705. end;
  2706.  
  2707. procedure TSRValueEdit.SetShowScrews(newValue: boolean);
  2708. begin
  2709.   if NewValue<>FShowScrews then begin
  2710.     FShowScrews:=NewValue;
  2711.     CalcBorderWidth;
  2712.     Invalidate;
  2713.   end;
  2714. end;
  2715.  
  2716. procedure TSRValueEdit.SetScrewSize(newValue: TScrewSize);
  2717. begin
  2718.   if NewValue<>FScrewSize then begin
  2719.     FScrewSize:=NewValue;
  2720.     CalcBorderWidth;
  2721.     Invalidate;
  2722.   end;
  2723. end;
  2724.  
  2725. procedure TSRValueEdit.SetRulerDirection(newValue: TRulerDirection);
  2726. begin
  2727.   if NewValue<>FRulerDirection then begin
  2728.     if (NewValue=rdHorizontal) and (FSliderEditWidth>Height) then
  2729.       SetSliderEditWidth(Height);
  2730.     if (NewValue=rdVertical) and (FSliderEditWidth>Width) then
  2731.       SetSliderEditWidth(Width);
  2732.     FRulerDirection:=NewValue;
  2733.   end;
  2734. end;
  2735.  
  2736. procedure TSRValueEdit.SetSliderEditWidth(newValue: integer);
  2737. begin
  2738.   if NewValue<>FSliderEditWidth then begin
  2739.     if (FRulerDirection=rdHorizontal) and (NewValue>Height) then
  2740.       NewValue:=Height;
  2741.     if (FRulerDirection=rdVertical) and (NewValue>Width) then
  2742.       NewValue:=Width;
  2743.     FSliderEditWidth:=NewValue;
  2744.   end;
  2745. end;
  2746.  
  2747. procedure TSRValueEdit.SetSpinBtnHeight(newValue: integer);
  2748. begin
  2749.   if NewValue<>FSpinBtnHeight then begin
  2750.     FSpinBtnHeight:=NewValue;
  2751.     if assigned(FNumericEdit) then
  2752.       FNumericEdit.BtnHeight:=NewValue;
  2753.     CalcBorderWidth;
  2754.     Invalidate;
  2755.   end;
  2756. end;
  2757.  
  2758. procedure TSRValueEdit.SetSpinControlWidth(newValue: integer);
  2759. begin
  2760.   if NewValue<>FSpinControlWidth then begin
  2761.     FSpinControlWidth:=NewValue;
  2762.     Invalidate;
  2763.   end;
  2764. end;
  2765.  
  2766. procedure TSRValueEdit.SetTickStyle(newValue: TTickStyle);
  2767. begin
  2768.   if NewValue<>FTickStyle then begin
  2769.     FTickStyle:=NewValue;
  2770.     Invalidate;
  2771.   end;
  2772. end;
  2773.  
  2774. procedure TSRValueEdit.SetValue(newValue: extended);
  2775. begin
  2776.   if NewValue<>FValue then begin
  2777.     if NewValue<FMinValue then
  2778.       NewValue:=FMinValue;
  2779.     if NewValue>FMaxValue then
  2780.       NewValue:=FMaxValue;
  2781.     FValue:=NewValue;
  2782.     DrawRadioControl(Focused);
  2783.     if assigned(FNumericEdit) then
  2784.       FNumericEdit.Value:=FValue;
  2785.     Change;
  2786.   end;
  2787. end;
  2788.  
  2789. procedure TSRValueEdit.ShowSliderEdit(AutoHide: boolean);
  2790. var SliderOffset,
  2791.     MouseOffset,
  2792.     SliderPos     : integer;
  2793.     PosOnForm,
  2794.     TopLeft,
  2795.     ACenter,
  2796.     CPoint,SPoint : TPoint;
  2797.     CrsrRect,
  2798.     ARect         : TRect;
  2799.     OwnerForm     : TForm;
  2800. begin
  2801.   { Positionen des SpinControls und des Mauszeigers ermitteln }
  2802.   if (Owner is TForm) then begin
  2803.     OwnerForm:=TForm(Owner);
  2804.     ARect:=GetSpinControlRect(ClientRect, true);
  2805.     GetCursorPos(CPoint);
  2806.     SPoint:=TForm(Owner).ScreenToClient(CPoint);
  2807.     ACenter.X:=ARect.Left+((ARect.Right-ARect.Left) div 2);
  2808.     ACenter.Y:=ARect.Top+((ARect.Bottom-ARect.Top) div 2);
  2809.     TopLeft:=ClientToScreen(Point(0, 0));
  2810.     PosOnForm:=OwnerForm.ScreenToClient(TopLeft);
  2811.  
  2812.     { SliderEdit erstellen }
  2813.     FSliderEdit:=TSliderEdit.Create(Self);
  2814.     if assigned(FOnShowSlider) then
  2815.       FOnShowSlider(Self);
  2816.     with FSliderEdit do begin
  2817.       FAutoHide:=AutoHide;
  2818.       Colors.Assign(Self.FColors);
  2819.       FocusRect:=Self.FFocusRect;
  2820.       TickStyle:=Self.FTickStyle;
  2821.       Font.Color:=Self.Font.Color;
  2822.       BevelWidth:=1;
  2823.       BevelStyle:=FBevelStyle;
  2824.       RulerDirection:=Self.FRulerDirection;
  2825.       MaxValue:=trunc(Self.FMaxValue);
  2826.       MinValue:=trunc(Self.FMinValue);
  2827.       Parent:=TForm(Self.Owner);
  2828.       SliderWidth:=Self.FSliderWidth;
  2829.       Value:=trunc(Self.FValue);
  2830.       ValueEdit:=Self;
  2831.       CalcDisplayHeight;
  2832.     end;
  2833.  
  2834.     if FRulerDirection=rdHorizontal then begin
  2835.       { Position und Gr÷▀e festlegen }
  2836.       FSliderEdit.FDisplayWidth:=FSliderEdit.Canvas.TextWidth(IntToStr(FSliderEdit.MinValue))+4;
  2837.       FSliderEdit.Width:=FSliderEditLength;
  2838.       FSliderEdit.Height:=FSliderEditWidth;
  2839.       SliderPos:=PosOnForm.X+ACenter.X-(FSliderEditLength div 2);
  2840.       if (SliderPos+FSliderEditLength)>=OwnerForm.ClientWidth then
  2841.         SliderPos:=OwnerForm.ClientWidth-FSliderEdit.Width-2;
  2842.       if SliderPos<0 then
  2843.         SliderPos:=2;
  2844.       FSliderEdit.Left:=SliderPos;
  2845.       FSliderEdit.Top:=PosOnForm.Y+ACenter.Y-(FSliderEditWidth div 2);
  2846.       { Mausposition ⁿber dem Ruler berechnen }
  2847.       SliderOffset:=FSliderEdit.GetSliderOffset(FSliderEdit.FValue);
  2848.       MouseOffset:=SliderOffset+FSliderEdit.BevelWidth+FSliderEdit.BorderWidth+
  2849.                    (FSliderEdit.DisplayWidth div 2)+(FSliderEdit.SliderWidth div 2)+3;
  2850.       CPoint:=Point(FSliderEdit.Left+MouseOffset, SPoint.Y);
  2851.     end
  2852.     else begin
  2853.       { Position und Gr÷▀e festlegen }
  2854.       FSliderEdit.Width:=FSliderEditWidth;
  2855.       FSliderEdit.Height:=FSliderEditLength;
  2856.       FSliderEdit.Left:=PosOnForm.X+ACenter.X-(FSliderEditWidth div 2);
  2857.       SliderPos:=PosOnForm.Y+ACenter.Y-(FSliderEditLength div 2);
  2858.       if (SliderPos+FSliderEdit.Height)>=OwnerForm.ClientHeight then
  2859.         SliderPos:=OwnerForm.ClientHeight-FSliderEdit.Height-2;
  2860.       if SliderPos<0 then
  2861.         SliderPos:=2;
  2862.       FSliderEdit.Top:=SliderPos;
  2863.       { Mausposition ⁿber dem Ruler berechnen }
  2864.       SliderOffset:=FSliderEdit.GetSliderOffset(FSliderEdit.Value);
  2865.       MouseOffset:=SliderOffset+FSliderEdit.BevelWidth+FSliderEdit.BorderWidth+
  2866.                    FSliderEdit.SpinBtnHeight+(FSliderEdit.SliderWidth div 2)+4;
  2867.       CPoint:=Point(SPoint.X, FSliderEdit.Top+FSliderEditLength-MouseOffset);
  2868.     end;
  2869.  
  2870.     { Anzeigen }
  2871.     FSliderEdit.FDrawBuffer.Width:=FSliderEdit.Width;
  2872.     FSliderEdit.FDrawBuffer.Height:=FSliderEdit.Height;
  2873.  
  2874.     { Mauscursor auf den Ruler setzen }
  2875.     CPoint:=OwnerForm.ClientToScreen(CPoint);
  2876.     SetCursorPos(CPoint.X, CPoint.Y);
  2877.     if AutoHide and FCaptureMouse then begin
  2878.       { Mausbereich auf den Slider einschrΣnken }
  2879.       GetWindowRect(FSliderEdit.Handle, CrsrRect);
  2880.       InflateRect(CrsrRect, -FSliderEdit.BorderWidth-FSliderEdit.BevelWidth,
  2881.                             -FSliderEdit.BorderWidth-FSliderEdit.BevelWidth);
  2882.       ClipCursor(@CrsrRect);
  2883.     end;
  2884.     if AutoHide then
  2885.       Self.Perform(WM_LButtonUp, 0, 0)
  2886.     else
  2887.       FSliderEdit.SetFocus;
  2888.   end;
  2889. end;
  2890.  
  2891. procedure TSRValueEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  2892. begin
  2893.   inherited;
  2894.   { Kein Fokuswechsel durch Cursortasten }
  2895.   Message.Result:=Message.Result or DLGC_WANTARROWS;
  2896. end;
  2897.  
  2898. procedure TSRValueEdit.WMKillFocus(var Message: TWMKillFocus);
  2899. begin
  2900.   inherited;
  2901.  
  2902.   if FocusRect then
  2903.     DoDrawFocusRect(false);
  2904.   if FValueHistory then
  2905.     AddValueToHistory(FValue);
  2906. end;
  2907.  
  2908. procedure TSRValueEdit.WMSetFocus(var Message: TWMSetFocus);
  2909. begin
  2910.   inherited;
  2911.  
  2912.   if FocusRect then
  2913.     DoDrawFocusRect(true);
  2914.   if assigned(FNumericEdit) then
  2915.     FNumericEdit.SetFocus;
  2916. end;
  2917.  
  2918. procedure TSRValueEdit.WMSize(var Message: TWMSize);
  2919. begin
  2920.   inherited;
  2921.  
  2922.   SetControlsPosAndWidth;
  2923.   Message.Result := 0;
  2924. end;
  2925.  
  2926. procedure Register;
  2927. begin
  2928.   RegisterComponents('Simon', [TSRValueEdit, TNumericEdit, TSliderEdit]);
  2929. end;
  2930.  
  2931. end.
  2932.