开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMSlider.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：42k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMSlider.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 30.03.98 - 16:35:32 $                                        =}
  24. {========================================================================}
  25. unit MMSlider;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.     Windows,
  34. {$ELSE}
  35.     WinTypes,
  36.     WinProcs,
  37. {$ENDIF}
  38.     Forms,
  39.     SysUtils,
  40.     Messages,
  41.     Classes,
  42.     Graphics,
  43.     Controls,
  44.     Dialogs,
  45.     ExtCtrls,
  46.     Menus,
  47.     MMObj,
  48.     MMUtils,
  49.     MMBCache,
  50.     MMMath,
  51.     MMString,
  52.     MMScale;
  55. type
  56.   TMMOrientation    = (orVertical,orHorizontal);
  57.   TMMThumbStyle     = (tsRect,tsOwnerDraw);
  58.   TMMGrooveStyle    = (gsRect,gsOwnerDraw);
  59.   TMMFocusAction    = (faNone, faFocusThumb, faFocusRect, faFocusColor, faAll);
  60.   TMMScalePos       = (spAboveOrLeft, spBelowOrRight, spBoth);
  61.   TMMThumbDrawEvent = procedure(Sender: TObject; aCanvas: TCanvas; aRect: TRect;
  62.                                 Dragged,Focused: Boolean) of object;
  63.   TMMGrooveDrawEvent= procedure(Sender: TObject; aCanvas: TCanvas; var aRect: TRect) of object;
  65.   {-- TMMCustomSlider ---------------------------------------------------}
  66.   TMMCustomSlider = class(TMMCustomControl)
  67.   private
  68.     FDragging                : Boolean;
  69.     FGroove                  : TMMBevel;
  70.     FHandCursor              : Boolean;
  71.     FThumbCursor             : TCursor;
  72.     FMax,FMin,FPosition      : Longint;
  73.     FLineSize                : Integer;
  74.     FPageSize                : Integer;
  75.     FOrientation             : TMMOrientation;
  76.     FFocusAction             : TMMFocusAction;
  77.     FThumbWidth, FThumbHeight: Byte;
  78.     FThumbColor              : TColor;
  79.     FThumbBorder             : Boolean;
  80.     FGrooveColor             : TColor;
  81.     FFocusColor              : TColor;
  82.     FDisabledColor           : TColor;
  83.     FFocusTime               : Boolean;
  84.     FScaleDistance           : Integer;
  85.     FScalePos                : TMMScalePos;
  86.     FScale                   : TMMScale;
  87.     FGrooveSize              : Byte;
  88.     FThumbStyle              : TMMThumbStyle;
  89.     FGrooveStyle             : TMMGrooveStyle;
  90.     FBitmap                  : TBitmap;
  91.     FForceChange             : Boolean;
  92.     FDragOffset              : integer;
  93.     FDragVal                 : Longint;
  94.     HalfTW,HalfTH            : Integer;
  95.     FThumbRect               : TRect;
  96.     FPicLeft                 : TBitmap;
  97.     FPicRight                : TBitmap;
  98.     FSensitivity             : integer;
  99.     FLogMode                 : Boolean;
  100.     FNeedTrackEnd            : Boolean;
  102.     FOnChange                : TNotifyEvent;
  103.     FOnTrack                 : TNotifyEvent;
  104.     FOnTrackEnd              : TNotifyEvent;
  105.     FOnDrawThumb             : TMMThumbDrawEvent;
  106.     FOnDrawGroove            : TMMGrooveDrawEvent;
  107.     FOnGetFocus              : TNotifyEvent; { Added January, 30 2000 }
  108.     FOnLostFocus             : TNotifYEvent; { Added January, 30 2000 }
  109.     FOnMouseEnter            : TNotifyEvent; { Added January, 30 2000 }
  110.     FOnMouseLeave            : TNotifyEvent; { Added January, 30 2000 }
  112.     procedure SetColors(index: integer; aValue: TColor);
  113.     procedure SetMax(aValue: Longint);
  114.     procedure SetMin(aValue: Longint);
  115.     procedure SetOrientation(aValue: TMMOrientation);
  116.     procedure SetPosition(aValue: Longint);
  117.     function  GetPosition: Longint;
  118.     function  UpdatePosition(aValue: Longint): Boolean;
  119.     procedure UpdateFocusTimer(Enable: Boolean);
  120.     procedure SetScaleDist(aValue: Integer);
  121.     procedure SetScalePos(aValue: TMMScalePos);
  122.     procedure SetScale(Value: TMMScale);
  123.     procedure SetFocusAction(aValue: TMMFocusAction);
  124.     procedure SetGrooveSize(aValue: Byte);
  125.     procedure SetThumbSize(index: integer; aValue: Byte);
  126.     procedure SetThumbBorder(aValue: Boolean);
  127.     procedure SetThumbStyle(aValue: TMMThumbStyle);
  128.     procedure SetGrooveStyle(aValue: TMMGrooveStyle);
  129.     procedure SetSensitivity(aValue: integer);
  130.     procedure SetLogMode(aValue: Boolean);
  131.     procedure SetGroove(aValue: TMMBevel);
  132.     procedure GrooveChanged(Sender: TObject);
  133.     procedure ScaleChanged(Sender: TObject);
  134.     procedure TimerAction(Sender: TObject);
  135.     procedure UpdateBitmap(aWidth,aHeight: integer);
  136.     function  NewPosition(WhereX,WhereY: Integer): integer;
  137.     function  IsVert: Boolean;
  138.     procedure WhereIsThumb(const ClientRect: TRect; var aRect: TRect);
  139.     procedure DrawTrench(Canvas: TCanvas; aRect: TRect);
  140.     procedure DrawScale(Canvas: TCanvas; aRect: TRect);
  141.     procedure DrawThumb(Canvas: TCanvas; aRect: TRect);
  142.     function  DrawGroove(Canvas: TCanvas; aRect: TRect): TRect;
  143.     function  DrawPics(Canvas: TCanvas; aRect: TRect): TRect;
  144.     procedure SetPicLeft(Value: TBitmap);
  145.     procedure SetPicRight(Value: TBitmap);
  146.     procedure PicChanged(Sender: TObject);
  147.     function  CalcClientRect: TRect;
  149.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFocus;
  150.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KillFocus;
  151.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  152.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  153.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  154.     procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER; { Added January, 30 2000 }
  155.     procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE; { Added January, 30 2000 }
  157.   protected
  158.     procedure Change; dynamic;
  159.     procedure Track; dynamic;
  160.     procedure TrackEnd; dynamic;
  161.     procedure OwnerDrawThumb(aCanvas: TCanvas; aRect: TRect; Dragged,Focused: Boolean); dynamic;
  162.     procedure OwnerDrawGroove(aCanvas: TCanvas; var aRect: TRect); dynamic;
  163.     procedure Paint; override;
  164.     procedure Loaded; override;
  165.     procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  166.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  167.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  168.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  169.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  170.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  171.     procedure SetThumbCursor(AtThumb: Boolean);
  172.   public
  173.     constructor Create(AOwner: TComponent); override;
  174.     destructor Destroy; override;
  176.     procedure SetMinMax(aMin,aMax: Longint);
  178.   protected
  179.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  180.     property OnTrack: TNotifyEvent read FOnTrack write FOnTrack;
  181.     property OnTrackEnd: TNotifyEvent read FOnTrackEnd write FOnTrackEnd;
  182.     property OnDrawThumb: TMMThumbDrawEvent read FOnDrawThumb write FOnDrawThumb;
  183.     property OnDrawGroove: TMMGrooveDrawEvent read FOnDrawGroove write FOnDrawGroove;
  184.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  185.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  186.     property OnGetFocus: TNotifyEvent read FOnGetFOcus write FOnGetFocus;
  187.     property OnLostFocus: TNotifyEvent read FOnLostFocus write FOnLostFocus;
  189.     property TabStop default True;
  190.     property Width default 200;
  191.     property Height default 40;
  192.     property Groove: TMMBevel read FGroove write SetGroove;
  193.     property FocusAction: TMMFocusAction read FFocusAction write SetFocusAction default faFocusRect;
  194.     property FocusColor: TColor index 0 read FFocusColor write SetColors default clActiveCaption;
  195.     property GrooveColor: TColor index 1 read FGrooveColor write SetColors default clBtnFace;
  196.     property ThumbColor: TColor index 2 read FThumbColor write SetColors default clBtnFace;
  197.     property DisabledColor: TColor index 3 read FDisabledColor write SetColors default clWhite;
  199.     property HandCursor: Boolean read FHandCursor write FHandCursor default False;
  200.     property ThumbCursor: TCursor read FThumbCursor write FThumbCursor default crDefault;
  202.     property MinValue: Longint read FMin write SetMin default 0;
  203.     property MaxValue: Longint read FMax write SetMax default 10;
  204.     property LineSize: Integer read FLineSize write FLineSize default 1;
  205.     property PageSize: Integer read FPageSize write FPageSize default 5;
  206.     property Orientation: TMMOrientation read FOrientation write SetOrientation default orHorizontal;
  207.     property Position: Longint read GetPosition write SetPosition default 0;
  208.     property GrooveSize: Byte read FGrooveSize write SetGrooveSize default 3;
  209.     property GrooveStyle: TMMGrooveStyle read FGrooveStyle write SetGrooveStyle default gsRect;
  210.     property ThumbWidth: Byte index 0 read FThumbWidth write SetThumbSize default 11;
  211.     property ThumbHeight: Byte index 1 read FThumbHeight write SetThumbSize default 23;
  212.     property ThumbStyle: TMMThumbStyle read FThumbStyle write SetThumbStyle default tsRect;
  213.     property ThumbBorder: Boolean read FThumbBorder write SetThumbBorder default True;
  214.     property ScaleDistance: Integer read FScaleDistance write SetScaleDist default 10;
  215.     property ScalePosition: TMMScalePos read FScalePos write SetScalePos default spBelowOrRight;
  216.     property Scale: TMMScale read FScale write SetScale;
  218.     property PicLeft: TBitmap read FPicLeft write SetPicLeft;
  219.     property PicRight: TBitmap read FPicRight write SetPicRight;
  221.     property Logarithmic: Boolean read FLogMode write SetLogMode default False;
  222.     property Sensitivity: Integer read FSensitivity write SetSensitivity default -24;
  223.   end;
  225.   {-- TMMSlider ---------------------------------------------------------}
  226.   TMMSlider = class(TMMCustomSlider)
  227.   published
  228.     property OnEnter;
  229.     property OnExit;
  230.     property OnKeyDown;
  231.     property OnKeyPress;
  232.     property OnKeyUp;
  233.     property OnChange;
  234.     property OnTrack;
  235.     property OnTrackEnd;
  236.     property OnDrawThumb;
  237.     property OnDrawGroove;
  238.     property OnMouseEnter; { Added January, 30 2000 }
  239.     property OnMouseLeave; { Added January, 30 2000 }
  240.     property OnGetFocus;   { Added January, 30 2000 }
  241.     property OnLostFocus;  { Added January, 30 2000 }
  243.     property Align;
  244.     property Visible;
  245.     property Color;
  246.     property Enabled;
  247.     property ParentShowHint;
  248.     property PopupMenu;
  249.     property ShowHint;
  250.     property TabStop;
  251.     property TabOrder;
  252.     property Width;
  253.     property Height;
  254.     property Bevel;
  255.     property Groove;
  256.     property FocusAction;
  257.     property FocusColor;
  258.     property GrooveColor;
  259.     property ThumbColor;
  260.     property ThumbBorder;
  261.     property DisabledColor;
  262.     property HandCursor;
  263.     property ThumbCursor;
  264.     property MinValue;
  265.     property MaxValue;
  266.     property LineSize;
  267.     property PageSize;
  268.     property Orientation;
  269.     property Position;
  270.     property GrooveSize;
  271.     property ThumbWidth;
  272.     property ThumbHeight;
  273.     property ThumbStyle;
  274.     property GrooveStyle;
  276.     property ScaleDistance;
  277.     property ScalePosition;
  278.     property Scale;
  280.     property PicLeft;
  281.     property PicRight;
  283.     property Logarithmic;
  284.     property Sensitivity;
  285.   end;
  287. implementation
  289. const
  290.      FocusTimer: TTimer = nil;
  291.      
  292. {== TMMCustomSlider =====================================================}
  293. constructor TMMCustomSlider.Create(AOwner: TComponent);
  294. begin
  295.    inherited Create(AOwner);
  297.    FBitmap := nil;
  298.    FGroove := TMMBevel.Create;
  299.    FGroove.OnChange := GrooveChanged;
  300.    Bevel.BorderWidth := 5;
  301.    Height := 40;
  302.    Width := 200;
  303.    FFocusAction:= faFocusRect;
  304.    FHandCursor := False;
  305.    FThumbCursor := crDefault;
  306.    FMin := 0;
  307.    FMax := 10;
  308.    FForceChange := False;
  309.    FLineSize := 1;
  310.    FPageSize := 5;
  311.    FOrientation := orHorizontal;
  312.    FPosition := 0;
  313.    FGrooveSize := 3;
  314.    FDragging := False;
  315.    FDragVal := 0;
  316.    FDragOffset := 0;
  317.    ThumbStyle := tsRect;
  318.    GrooveStyle := gsRect;
  319.    FFocusColor := clActiveCaption;
  320.    FGrooveColor := clBtnFace;
  321.    FThumbColor := clBtnFace;
  322.    FThumbBorder:= True;
  323.    FDisabledColor := clWhite;
  324.    FScalePos := spBelowOrRight;
  325.    FScale := TMMScale.Create;
  326.    FScale.OnChange  := ScaleChanged;
  327.    FScale.Visible := False;
  328.    FScale.Origin := soOuter;
  329.    FScale.Connect := True;
  330.    FScaleDistance := 10;
  331.    FFocusTime := False;
  332.    FSensitivity := -24;
  333.    FLogMode := False;
  334.    FNeedTrackEnd := False;
  335.    TabStop := True;
  336.    FThumbWidth := 11;
  337.    ThumbHeight := 23;
  339.    FPicLeft := TBitmap.Create;
  340.    FPicRight := TBitmap.Create;
  341.    FPicLeft.OnChange := PicChanged;
  342.    FPicRight.OnChange := PicChanged;
  344.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  345.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  346. end;
  348. {-- TMMCustomSlider -----------------------------------------------------}
  349. destructor TMMCustomSlider.Destroy;
  350. begin
  351.    FGroove.OnChange := Nil;
  352.    FGroove.Free;
  354.    RemoveCacheBitmap(FBitmap);
  356.    UpdateFocusTimer(False);
  358.    FScale.Free;
  360.    FPicLeft.Free;
  361.    FPicRight.Free;
  363.    inherited Destroy;
  364. end;
  366. {-- TMMCustomSlider -----------------------------------------------------}
  367. procedure TMMCustomSlider.Change;
  368. begin
  369.    if (csLoading in ComponentState) or
  370.       (csReading in ComponentState) then exit;
  372.    if assigned(FOnChange) then FOnChange(Self);
  373. end;
  375. {-- TMMCustomSlider -----------------------------------------------------}
  376. procedure TMMCustomSlider.Track;
  377. begin
  378.    FNeedTrackEnd := True;
  379.    if assigned(FOnTrack) then FOnTrack(Self);
  380. end;
  382. {-- TMMCustomSlider -----------------------------------------------------}
  383. procedure TMMCustomSlider.TrackEnd;
  384. begin
  385.    if FNeedTrackEnd then
  386.    begin
  387.       if assigned(FOnTrackEnd) then FOnTrackEnd(Self);
  388.       FNeedTrackEnd := False;
  389.    end;
  390. end;
  392. {-- TMMCustomSlider -----------------------------------------------------}
  393. procedure TMMCustomSlider.OwnerDrawThumb(aCanvas: TCanvas; aRect: TRect; Dragged,Focused: Boolean);
  394. begin
  395.    if assigned(FOnDrawThumb) then FOnDrawThumb(Self,aCanvas,aRect,Dragged,Focused);
  396. end;
  398. {-- TMMCustomSlider -----------------------------------------------------}
  399. procedure TMMCustomSlider.OwnerDrawGroove(aCanvas: TCanvas; var aRect: TRect);
  400. begin
  401.    if Assigned(FOnDrawGroove) then FOnDrawGroove(Self,aCanvas,aRect);
  402. end;
  404. {-- TMMCustomSlider -----------------------------------------------------}
  405. Procedure TMMCustomSlider.SetGroove(aValue: TMMBevel);
  406. begin
  407.    FGroove.Assign(aValue);
  408. end;
  410. {-- TMMCustomSlider -----------------------------------------------------}
  411. procedure TMMCustomSlider.GrooveChanged(Sender: TObject);
  412. begin
  413.    Changed;
  414. end;
  416. {-- TMMCustomSlider -----------------------------------------------------}
  417. procedure TMMCustomSlider.ScaleChanged(Sender: TObject);
  418. begin
  419.    Changed;
  420. end;
  422. {-- TMMCustomSlider -----------------------------------------------------}
  423. procedure TMMCustomSlider.PicChanged(Sender: TObject);
  424. begin
  425.    Changed;
  426. end;
  428. {-- TMMCustomSlider -----------------------------------------------------}
  429. function  TMMCustomSlider.CalcClientRect: TRect;
  430. begin
  431.     Result := BeveledRect;
  433.     if not FPicLeft.Empty then
  434.         if Orientation = orHorizontal then
  435.             Inc(Result.Left,FPicLeft.Width)
  436.         else
  437.             Inc(Result.Top,FPicLeft.Height);
  439.     if not FPicRight.Empty then
  440.         if Orientation = orHorizontal then
  441.             Dec(Result.Right,FPicRight.Width)
  442.         else
  443.             Dec(Result.Bottom,FPicRight.Height);
  444. end;
  446. {-- TMMCustomSlider -----------------------------------------------------}
  447. procedure TMMCustomSlider.WMSetFocus(var Message: TWMSetFocus);
  448. begin
  449.    inherited;
  451.    { Added January, 30 2000 }
  452.    if Assigned(FOnGetFocus) then FOnGetFocus(Self);
  454.    if (FFocusAction <> faNone) then
  455.    begin
  456.       UpdateFocusTimer(True);
  457.       Refresh;
  458.    end;
  459. end;
  461. {-- TMMCustomSlider -----------------------------------------------------}
  462. procedure TMMCustomSlider.WMKillFocus(var Message: TWMKillFocus);
  463. begin
  464.    inherited;
  466.    { Added January, 30 2000 }
  467.    if Assigned(FOnLostFocus) then FOnLostFocus(Self);
  469.    if (FFocusAction <> faNone) then
  470.    begin
  471.       UpdateFocusTimer(False);
  472.       Refresh;
  473.    end;
  474. end;
  476. {-- TMMCustomSlider -----------------------------------------------------}
  477. procedure TMMCustomSlider.WMGetDlgCode(var Message: TWMGetDlgCode);
  478. begin
  479.   Message.Result := DLGC_WANTARROWS;
  480. end;
  482. {-- TMMCustomSlider -----------------------------------------------------}
  483. procedure TMMCustomSlider.CMEnabledChanged(var Message: TMessage);
  484. begin
  485.    inherited;
  487.    Refresh;
  488. end;
  490. {-- TMMCustomSlider -----------------------------------------------------}
  491. procedure TMMCustomSlider.WMSize(var Message: TWMSize);
  492. begin
  493.    if Height > Width then
  494.       Orientation := orVertical else Orientation := orHorizontal;
  495. end;
  497. {-- TMMCustomSlider -----------------------------------------------------}
  498. procedure TMMCustomSlider.Loaded;
  499. begin
  500.    inherited Loaded;
  502.    UpdateBitmap(Width,Height);
  503. end;
  505. {-- TMMCustomSlider -----------------------------------------------------}
  506. procedure TMMCustomSlider.UpdateBitmap(aWidth,aHeight: integer);
  507. begin
  508.    if (csLoading in ComponentState) or
  509.       (csReading in ComponentState) then exit;
  511.    RemoveCacheBitmap(FBitmap);
  512.    FBitmap := LoadCacheBitmap(Max(aWidth,0),Max(aHeight,0));
  514.    Invalidate;
  515. end;
  517. {-- TMMCustomSlider -----------------------------------------------------}
  518. procedure TMMCustomSlider.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  519. begin
  520.    if (Width <> aWidth) or (Height <> aHeight) or (FBitmap = nil) then
  521.    begin
  522.       UpdateBitmap(aWidth,aHeight);
  523.    end;
  525.    inherited SetBounds(aLeft, aTop, aWidth, aHeight);
  526. end;
  528. {-- TMMCustomSlider -----------------------------------------------------}
  529. procedure TMMCustomSlider.SetColors(index: integer; aValue: TColor);
  530. begin
  531.    case index of
  532.       0: if aValue = FFocusColor then exit else FFocusColor := aValue;
  533.       1: if aValue = FGrooveColor then exit else FGrooveColor := aValue;
  534.       2: if aValue = FThumbColor then exit else FThumbColor := aValue;
  535.       3: if aValue = FDisabledColor then exit else FDisabledColor := aValue;
  536.    end;
  537.    Refresh;
  539.    {$IFDEF WIN32}
  540.    {$IFDEF TRIAL}
  541.    {$DEFINE _HACK1}
  542.    {$I MMHACK.INC}
  543.    {$ENDIF}
  544.    {$ENDIF}
  545. end;
  547. {-- TMMCustomSlider -----------------------------------------------------}
  548. procedure TMMCustomSlider.SetThumbBorder(aValue: Boolean);
  549. begin
  550.    if (aValue <> FThumbBorder) then
  551.    begin
  552.       FThumbBorder := aValue;
  553.       Invalidate;
  554.    end;
  555. end;
  556. {-- TMMCustomSlider -----------------------------------------------------}
  557. procedure TMMCustomSlider.SetThumbSize(index: integer; aValue: Byte);
  558. begin
  559.    case Index of
  560.        0: if (aValue = FThumbWidth) then exit else FThumbWidth := aValue;
  561.        1: if (aValue = FThumbHeight) then exit else FThumbHeight := aValue;
  562.    end;
  563.    HalfTH := FThumbHeight div 2;
  564.    HalfTW := FThumbWidth div 2;
  565.    Refresh;
  567.    {$IFDEF WIN32}
  568.    {$IFDEF TRIAL}
  569.    {$DEFINE _HACK2}
  570.    {$I MMHACK.INC}
  571.    {$ENDIF}
  572.    {$ENDIF}
  573. end;
  575. {-- TMMCustomSlider -----------------------------------------------------}
  576. procedure TMMCustomSlider.SetThumbStyle(aValue: TMMThumbStyle);
  577. begin
  578.    if (FThumbStyle <> aValue) then
  579.    begin
  580.       FThumbStyle := aValue;
  581.       Refresh;
  582.    end;
  583. end;
  585. {-- TMMCustomSlider -----------------------------------------------------}
  586. procedure TMMCustomSlider.SetGrooveStyle(aValue: TMMGrooveStyle);
  587. begin
  588.    if (FGrooveStyle <> aValue) then
  589.    begin
  590.       FGrooveStyle := aValue;
  591.       Refresh;
  592.    end;
  593. end;
  595. {-- TMMCustomSlider -----------------------------------------------------}
  596. procedure TMMCustomSlider.SetSensitivity(aValue: integer);
  597. var
  598.    oldVal: integer;
  599. begin
  600.    aValue:= MinMax(aValue, -96, -20);
  601.    if aValue <> FSensitivity then
  602.    begin
  603.       oldVal := Position;
  604.       FSensitivity:= aValue;
  605.       Position := oldVal;
  606.    end;
  607. end;
  609. {-- TMMCustomSlider -----------------------------------------------------}
  610. procedure TMMCustomSlider.SetLogMode;
  611. var
  612.    oldVal: integer;
  613. begin
  614.    if (aValue <> FlogMode) then
  615.    begin
  616.       oldVal := Position;
  617.       FLogMode := aValue;
  618.       Position := oldVal;
  619.    end;
  620. end;
  622. {-- TMMCustomSlider -----------------------------------------------------}
  623. procedure TMMCustomSlider.SetMin(aValue: Longint);
  624. begin
  625.    SetMinMax(aValue,FMax);
  626. end;
  628. {-- TMMCustomSlider -----------------------------------------------------}
  629. procedure TMMCustomSlider.SetMax(aValue: Longint);
  630. begin
  631.    SetMinMax(FMin,aValue);
  632. end;
  634. {-- TMMCustomSlider -----------------------------------------------------}
  635. procedure TMMCustomSlider.SetMinMax(aMin,aMax: Longint);
  636. begin
  637.    if (Fmin <> aMin) or (FMax <> aMax) then
  638.    begin
  639.       FMin := aMin;
  640.       FMax := aMax;
  641.       if not (csLoading in ComponentState) then
  642.          FMax := Max(FMax,FMin+1);
  643.       FForceChange := True;
  644.       Position := MinMax(Position,FMin,FMax);
  645.       FForceChange := False;
  646.       Refresh;
  647.    end;
  648. end;
  650. {-- TMMCustomSlider -----------------------------------------------------}
  651. procedure TMMCustomSlider.SetOrientation(aValue: TMMOrientation);
  652. var
  653.    Temp: integer;
  655. begin
  656.    if (aValue <> FOrientation) then
  657.    begin
  658.       FOrientation := aValue;
  659.       if (csDesigning in ComponentState) and
  660.          not (csLoading in ComponentState) and
  661.          not (csReading in ComponentState) then
  662.       begin
  663.          { exchange Thumb sizes }
  664.          Temp := ThumbWidth;
  665.          ThumbWidth := ThumbHeight;
  666.          ThumbHeight := Temp;
  668.          if (isVert and (Width > Height)) or
  669.             (not isVert and (Height > Width)) then
  670.             SetBounds(Left,Top,Height,Width);
  671.       end;
  672.       Refresh;
  673.    end;
  674.    {$IFDEF WIN32}
  675.    {$IFDEF TRIAL}
  676.    {$DEFINE _HACK2}
  677.    {$I MMHACK.INC}
  678.    {$ENDIF}
  679.    {$ENDIF}
  680. end;
  682. {-- TMMCustomSlider -----------------------------------------------------}
  683. function TMMCustomSlider.UpdatePosition(aValue: Longint): Boolean;
  684. var
  685.    aRect: TRect;
  686. begin
  687.    if (aValue <> FPosition) or FForceChange then
  688.    begin
  689.       Result := True;
  690.       FPosition := MinMax(aValue,FMin,FMax);
  691.       if not (csDesigning in ComponentState) and
  692.          not (csLoading in ComponentState) then
  693.       begin
  694.          WhereIsThumb(CalcClientRect,aRect);
  696.          if (aRect.Left <> FThumbRect.Left) or (aRect.Top <> FThumbRect.Top) or
  697.             (aRect.Right <> FThumbRect.Right) or (aRect.Bottom <> FThumbRect.Bottom) then
  698.          begin
  699.             Refresh;
  700.          end;
  701.          Change;
  702.       end
  703.       else Refresh;
  704.    end
  705.    else Result := False;
  706. end;
  708. {-- TMMCustomSlider -----------------------------------------------------}
  709. procedure TMMCustomSlider.SetPosition(aValue: Longint);
  710. var
  711.    aPos: Float;
  712. begin
  713.    if FLogMode and (aValue <> 0) then
  714.    begin
  715.       aPos:= Log10(aValue/(FMax-FMin))*20 + -FSensitivity;
  716.       aPos:= MinMax(Round(aPos*(FMax-FMin)/-FSensitivity),FMin,FMax);
  717.       aValue := Round(aPos);
  718.    end;
  719.    UpdatePosition(aValue);
  720. end;
  722. {-- TMMCustomSlider -----------------------------------------------------}
  723. function TMMCustomSlider.GetPosition: Longint;
  724. var
  725.    aPos: Float;
  726. begin
  727.    aPos := MinMax(FPosition,FMin,FMax);
  729.    if FLogMode and (aPos <> 0) then
  730.    begin
  731.       aPos:= Pow(10,(aPos*(-FSensitivity)/(FMax-FMin)-(-FSensitivity))/20)*(FMax-FMin);
  732.    end;
  733.    Result := MinMax(Round(aPos),FMin,FMax);
  734. end;
  736. {-- TMMCustomSlider -----------------------------------------------------}
  737. procedure TMMCustomSlider.SetGrooveSize(aValue: Byte);
  738. begin
  739.    If (aValue >= 0) then
  740.    begin
  741.       FGrooveSize := aValue;
  742.       Refresh;
  743.    end;
  744. end;
  746. {-- TMMCustomSlider -----------------------------------------------------}
  747. procedure TMMCustomSlider.SetScaleDist(aValue: Integer);
  748. begin
  749.   if (aValue <> FScaleDistance) then
  750.   begin
  751.      FScaleDistance := aValue;
  752.      Refresh;
  753.   end;
  754. end;
  756. {-- TMMCustomSlider -----------------------------------------------------}
  757. procedure TMMCustomSlider.SetScalePos(aValue: TMMScalePos);
  758. begin
  759.    if (aValue <> FScalePos) then
  760.    begin
  761.       FScalePos := aValue;
  762.       Refresh;
  763.    end;
  764. end;
  766. {-- TMMCustomSlider -----------------------------------------------------}
  767. procedure TMMCustomSlider.SetScale(Value: TMMScale);
  768. begin
  769.     FScale.Assign(Value);
  770. end;
  772. {-- TMMCustomSlider -----------------------------------------------------}
  773. procedure TMMCustomSlider.TimerAction(Sender: TObject);
  774. begin
  775.    if not FDragging then
  776.    begin
  777.       FFocusTime := not FFocusTime;
  778.       Refresh;
  779.    end
  780.    else FFocusTime := True;
  781. end;
  783. {-- TMMCustomSlider -----------------------------------------------------}
  784. procedure TMMCustomSlider.UpdateFocusTimer(Enable: Boolean);
  785. begin
  786.    if (FocusTimer <> nil) and (FocusTimer.Owner = Self) then
  787.    begin
  788.       FocusTimer.Enabled := False;
  789.       FocusTimer.Free;
  790.       FocusTimer :=  nil;
  791.       FFocusTime := False;
  792.    end;
  794.    if not (csDesigning in ComponentState) then
  795.    begin
  796.       if Enable and Focused and (FocusAction in [faFocusThumb,faAll]) then
  797.       begin
  798.          if (FocusTimer = nil) then FocusTimer := TTimer.Create(Self);
  799.          FocusTimer.OnTimer := TimerAction;
  800.          FocusTimer.Interval := 500;
  801.          FocusTimer.Enabled := True;
  802.       end;
  803.    end;
  804. end;
  806. {-- TMMCustomSlider -----------------------------------------------------}
  807. procedure TMMCustomSlider.SetFocusAction(aValue: TMMFocusAction);
  808. begin
  809.   if (FFocusAction <> aValue) then
  810.   begin
  811.      FFocusAction := aValue;
  812.      UpdateFocusTimer(Enabled);
  813.      Refresh;
  814.   end;
  815. end;
  817. {-- TMMCustomSlider -----------------------------------------------------}
  818. function TMMCustomSlider.NewPosition(WhereX,WhereY: Integer): integer;
  819. var
  820.   aHeight,aWidth: Integer;
  822. begin
  823.    { Calculate the nearest position to where the mouse is located }
  824.    with CalcClientRect do
  825.    begin
  826.       aHeight := Bottom - Top - FThumbHeight;
  827.       aWidth  := Right - Left -FThumbWidth;
  828.       WhereY  := WhereY - Top - HalfTH;
  829.       WhereX  := WhereX - Left - HalfTW;
  830.    end;
  832.    if IsVert then
  833.       Result := Round(((aHeight-WhereY)/aHeight)*(FMax-FMin)+FMin)
  834.    else
  835.       Result := Round((WhereX/aWidth)*(FMax-FMin)+FMin);
  837.    Result := Min(Max(Result,FMin),FMax);
  838. end;
  840. {-- TMMCustomSlider -----------------------------------------------------}
  841. function TMMCustomSlider.IsVert: Boolean;
  842. begin
  843.    IsVert := (Orientation = orVertical);
  844. end;
  846. {-- TMMCustomSlider -----------------------------------------------------}
  847. procedure TMMCustomSlider.KeyDown(var Key: Word; Shift: TShiftState);
  848. var
  849.   Pos : Integer;
  851. begin
  852.    Pos := FPosition; { To avoid compiler warning }
  854.    try
  855.       case Key of
  856.          VK_NEXT : if (FPosition-FPageSize) > FMin then
  857.                        Pos := FPosition - FPageSize else Pos := FMin;
  858.          VK_PRIOR: if (FPosition+FPageSize) < FMax then
  859.                        Pos := FPosition + FPageSize else Pos := FMax;
  860.          VK_END  : if IsVert then Pos := FMin else Pos := FMax;
  861.          VK_HOME : if IsVert then Pos := FMax else Pos := FMin;
  862.          VK_LEFT,
  863.          VK_DOWN : if FPosition > FMin then Pos := FPosition - FLineSize;
  864.          VK_UP,
  865.          VK_RIGHT: if FPosition < FMax then Pos := FPosition + FLineSize;
  866.         else exit;
  867.       end;
  868.       if UpdatePosition(Pos) then Track;
  870.    finally
  871.       inherited KeyDown(Key,Shift);
  872.    end;
  873. end;
  875. {-- TMMCustomSlider -----------------------------------------------------}
  876. procedure TMMCustomSlider.KeyUp(var Key: Word; Shift: TShiftState);
  877. begin
  878.    TrackEnd;
  880.    inherited KeyUp(Key,Shift);
  881. end;
  883. {-- TMMCustomSlider -----------------------------------------------------}
  884. procedure TMMCustomSlider.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  885. begin
  886. {$IFNDEF BUILD_ACTIVEX}
  887.    SetFocus;
  888. {$ELSE}
  889.    Windows.SetFocus(Handle);
  890. {$ENDIF}
  892.    if PtInRect(FThumbRect,Point(X,Y)) then
  893.    begin
  894.       if (Button = mbLeft) then FDragging := True;
  896.       SetThumbCursor(True);
  897.    end;
  899.    if (Button = mbLeft) then
  900.    begin
  901.       if IsVert then
  902.          FDragOffset := Y
  903.       else
  904.          FDragOffset := X;
  906.       FDragVal := FPosition;
  908.       if not FDragging then
  909.       begin
  910.          if not UpdatePosition(NewPosition(X,Y)) then
  911.             Invalidate;
  912.       end
  913.       else Invalidate;
  915.       Track;
  916.    end;
  918.    inherited MouseDown(Button, Shift, X, Y);
  919. end;
  921. {-- TMMCustomSlider -----------------------------------------------------}
  922. procedure TMMCustomSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
  923. var
  924.    aPos,aWidth,aHeight: integer;
  926. begin
  927.    if not FDragging then
  928.    begin
  929.      {$IFDEF WIN32}
  930.      SetThumbCursor(ptInRect(FThumbRect,Point(X,Y)));
  931.      {$ELSE}
  932.      SetThumbCursor(ptInRect(FThumbRect,Point(X,Y)) or FDragging);
  933.      {$ENDIF}
  934.    end;
  936.    {Is the left mouse button down and dragging the thumb bar?}
  937.    if (ssLeft in Shift) and FDragging then
  938.    begin
  939.       with CalcClientRect do
  940.       begin
  941.          aHeight := Bottom - Top - FThumbHeight;
  942.          aWidth  := Right - Left - FThumbWidth;
  943.       end;
  945.       if IsVert then
  946.          aPos := MulDiv(FDragOffset-Y,FMax-FMin,aHeight)
  947.       else
  948.          aPos := MulDiv(X-FDragOffset,FMax-FMin,aWidth);
  950.       aPos := Min(Max(FDragVal+aPos,FMin),FMax);
  952.       if UpdatePosition(aPos) then Track;
  953.    end;
  955.    inherited MouseMove(Shift, X, Y);
  956. end;
  958. {-- TMMCustomSlider -----------------------------------------------------}
  959. procedure TMMCustomSlider.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  960. begin
  961.    if (Button = mbLeft) then
  962.    begin
  963.       FDragging := False;
  964.       Refresh;
  966.       TrackEnd;
  967.    end;
  969.    inherited MouseUp(Button, Shift, X, Y);
  970. end;
  972. {-- TMMCustomSlider -----------------------------------------------------}
  973. procedure TMMCustomSlider.WhereIsThumb(const ClientRect: TRect; var aRect: Trect);
  974. var
  975.   Each              : Real;
  976.   ThumbX,ThumbY     : Integer;
  977.   AWidth, AHeight   : Integer ;
  978. begin
  979.    AWidth := ClientRect.Right - ClientRect.Left ;
  980.    AHeight := ClientRect.Bottom - ClientRect.Top ;
  981.    { Calculate where to paint the thumb bar - store in aRect }
  982.    if IsVert then
  983.    begin
  984.       Each   := (AHeight-FThumbHeight)/(FMax-FMin);
  985.       ThumbY := AHeight-Round(Each*(FPosition-FMin))-FThumbHeight;
  986.       ThumbY := ClientRect.Top + Max(0,Min(AHeight-FThumbHeight,ThumbY));
  988.       if Scale.Visible and (FScalePos = spBelowOrRight) then
  989.          ThumbX := ClientRect.Left
  990.       else if Scale.Visible and (FScalePos = spAboveOrLeft) then
  991.          ThumbX := ClientRect.Left + AWidth-ThumbWidth
  992.       else
  993.          ThumbX := ClientRect.Left + AWidth div 2 - HalfTW;
  994.    end
  995.    else
  996.    begin
  997.       Each := (AWidth-FThumbWidth)/(FMax-FMin);
  998.       ThumbX := Round(Each*(FPosition-FMin));
  999.       ThumbX := ClientRect.Left + Max(0,Min(AWidth-FThumbWidth,ThumbX));
  1001.       if Scale.Visible and (FScalePos = spBelowOrRight) then
  1002.          ThumbY := ClientRect.Top
  1003.       else if Scale.Visible and (FScalePos = spAboveOrLeft) then
  1004.          ThumbY := ClientRect.Top + AHeight-ThumbHeight
  1005.       else
  1006.          ThumbY := ClientRect.Top + AHeight div 2 - HalfTH;
  1007.    end;
  1008.    aRect := Rect(ThumbX,ThumbY,ThumbX+FThumbWidth,ThumbY+FThumbHeight);
  1009. end;
  1011. {-- TMMCustomSlider -----------------------------------------------------}
  1012. procedure TMMCustomSlider.DrawScale(Canvas: TCanvas; aRect: TRect);
  1013. begin
  1014.    if Scale.Visible then
  1015.    with Scale do
  1016.    begin
  1017.       MinValue := Self.MinValue;
  1018.       MaxValue := Self.MaxValue;
  1019.    end
  1020.    else Exit;
  1022.    Scale.Canvas := Canvas;
  1024.    if isVert then
  1025.    begin
  1026.       Inc(aRect.Top, HalfTH);
  1027.       Dec(aRect.Bottom, HalfTH);
  1028.       if (FScalePos = spAboveOrLeft) or (FScalePos = spBoth) then
  1029.           Scale.DrawRect(Canvas,Rect(aRect.Left-Scale.ScaleHeight-FScaleDistance,
  1030.                          aRect.Top,aRect.Left-FScaleDistance,aRect.Bottom),True);
  1031.       if (FScalePos = spBelowOrRight) or (FScalePos = spBoth) then
  1032.           Scale.DrawRect(Canvas,Rect(aRect.Right+FScaleDistance,
  1033.                          aRect.Top,aRect.Right+Scale.ScaleHeight+FScaleDistance,
  1034.                          aRect.Bottom),False);
  1035.    end
  1036.    else
  1037.    begin
  1038.       Inc(aRect.Left, HalfTW);
  1039.       Dec(aRect.Right, HalfTW);
  1040.       if (FScalePos = spAboveOrLeft) or (FScalePos = spBoth) then
  1041.           Scale.DrawRect(Canvas,Rect(aRect.Left,aRect.Top-Scale.ScaleHeight-FScaleDistance-1,
  1042.                          aRect.Right,aRect.Top-FScaleDistance-1),True);
  1043.       if (FScalePos = spBelowOrRight) or (FScalePos = spBoth) then
  1044.           Scale.DrawRect(Canvas,Rect(aRect.Left,aRect.Bottom+FScaleDistance+1,
  1045.                          aRect.Right,aRect.Bottom+Scale.ScaleHeight+FScaleDistance+1),False);
  1046.    end;
  1047. end;
  1049. {-- TMMCustomSlider -----------------------------------------------------}
  1050. procedure TMMCustomSlider.DrawTrench(Canvas: TCanvas; aRect: TRect);
  1051. var
  1052.   aWidth,aHeight: integer;
  1053.   X1,Y1,X2,Y2   : integer;
  1054.   R1,R2,R3      : TRect;
  1056. begin
  1057.    {This procedure simply draws the slot that the thumb bar will travel through}
  1058.    {including the tick-marks. The bar itself is not drawn.}
  1060.    {Calculate the corners of the trench dependant on orientation}
  1061.    aWidth := aRect.Right-aRect.Left;
  1062.    aHeight:= aRect.Bottom-aRect.Top;
  1063.    with Canvas do
  1064.    begin
  1065.       if IsVert then
  1066.       begin
  1067.          if Scale.Visible and (FScalePos = spBelowOrRight) then
  1068.             X1 := aRect.Left+HalfTW-FGroove.BevelExtend -(FGrooveSize div 2)
  1069.          else if Scale.Visible and (FScalePos = spAboveOrLeft) then
  1070.             X1 := aRect.Right-HalfTW-FGroove.BevelExtend-(FGrooveSize div 2)-1
  1071.          else
  1072.             X1 := aRect.Left+(aWidth div 2) - FGroove.BevelExtend -(FGrooveSize div 2);
  1074.          X2 := X1 + 2*FGroove.BevelExtend + FGrooveSize;
  1075.          Y1 := aRect.Top;
  1076.          Y2 := aRect.Bottom;
  1077.       end
  1078.       else
  1079.       begin
  1080.          if Scale.Visible and (FScalePos = spBelowOrRight) then
  1081.             Y1 := aRect.Top+HalfTH-FGroove.BevelExtend -(FGrooveSize div 2)
  1082.          else if Scale.Visible and (FScalePos = spAboveOrLeft) then
  1083.             Y1 := aRect.Bottom-HalfTH-FGroove.BevelExtend-(FGrooveSize div 2)-1
  1084.          else
  1085.             Y1 := aRect.Top+(aHeight div 2)-FGroove.BevelExtend-(FGrooveSize div 2);
  1087.          Y2 := Y1 + 2*FGroove.BevelExtend+ FGrooveSize;
  1088.          X1 := aRect.Left;
  1089.          X2 := aRect.Right;
  1090.       end;
  1091.       R1 := Rect(X1,Y1,X2,Y2);
  1093.       DrawScale(Canvas,R1);
  1095.       R2 := DrawGroove(Canvas,R1);
  1097.       {Now do a filled rectangle in the center if the control has focus}
  1098.       Brush.Color := FGrooveColor;
  1099.       if Focused then
  1100.       begin
  1101.          if (FFocusAction = faFocusRect) or (FFocusAction = faAll) then
  1102.          begin
  1103.             R3 := aRect;
  1104.             if ((Bevel.BorderWidth > 0) and (Bevel.BevelInner = bvNone)) or
  1105.                (Bevel.BorderSpace > 0) then
  1106.                InflateRect(R3,1,1);
  1107.             DrawFocusRect(R3);
  1108.          end;
  1110.          if (FFocusAction = faFocusColor) or (FFocusAction = faAll) then
  1111.              Brush.Color := FocusColor;
  1112.       end;
  1113.       FillRect(R2);
  1114.    end;
  1115. end;
  1117. {-- TMMCustomSlider -----------------------------------------------------}
  1118. procedure TMMCustomSlider.DrawThumb(Canvas: TCanvas; aRect: Trect);
  1119. var
  1120.    X, Y: integer;
  1121.    Clr: TColor;
  1123. begin
  1124.    with Canvas,aRect do
  1125.    begin
  1126.       case FThumbStyle of
  1127.         tsOwnerDraw: OwnerDrawThumb(Canvas, aRect, FDragging, FFocusTime);
  1128.         tsRect:
  1129.         begin
  1130.            if FThumbBorder then
  1131.               Frame3D(Canvas, aRect, clWindowFrame, clWindowFrame, 1)
  1132.            else
  1133.            begin
  1134.               Pen.Color := clWindowFrame;
  1135.               MoveTo(aRect.Left,aRect.Bottom-1);
  1136.               LineTo(aRect.Right-1,aRect.Bottom-1);
  1137.               LineTo(aRect.Right-1,aRect.Top-1);
  1138.               dec(aRect.Right);
  1139.               dec(aRect.Bottom);
  1140.            end;
  1142.            Frame3D(Canvas, aRect, clBtnHighlight, clBtnShadow, 1);
  1144.            Pixels[aRect.Right,aRect.Top-1] := clBtnHighLight;
  1145.            Pixels[aRect.Left-1,aRect.Bottom] := clBtnHighLight;
  1147.            Brush.Color := FThumbColor;
  1148.            FillRect(aRect);
  1150.            if not Enabled or FFocusTime then
  1151.            begin
  1152.               if not Enabled then
  1153.                  Clr := FDisabledColor
  1154.               else
  1155.                  Clr := clBlack;
  1157.               for Y := aRect.Top to aRect.Bottom-1 do
  1158.                   for X := aRect.Left to aRect.Right-1 do
  1159.                   if (Y mod 2) = (X mod 2) then
  1160.                      Pixels[X, Y] := Clr;
  1161.            end;
  1162.         end;
  1163.       end;
  1164.    end;
  1165. end;
  1167. {-- TMMCustomSlider -----------------------------------------------------}
  1168. function  TMMCustomSlider.DrawPics(Canvas: TCanvas; aRect: TRect): TRect;
  1169. var
  1170.     AWidth, AHeight: Integer;
  1171.     OrigX, OrigY   : Integer;
  1173.     procedure   DrawPic(Pic: TBitmap; R: TRect);
  1174.     var
  1175.         X, Y: Integer;
  1176.     begin
  1177.         X := R.Left + (R.Right - R.Left - Pic.Width) div 2;
  1178.         Y := R.Top + (R.Bottom - R.Top - Pic.Height) div 2;
  1179.         Canvas.BrushCopy(Bounds(X,Y,Pic.Width,Pic.Height),Pic,Bounds(0,0,Pic.Width,Pic.Height),Pic.TransparentColor);
  1180.     end;
  1181. begin
  1182.     AWidth := aRect.Right - aRect.Left;
  1183.     AHeight:= aRect.Bottom- aRect.Top;
  1185.     OrigY := AHeight div 2 + aRect.Top;
  1186.     if Orientation = orHorizontal then
  1187.         if Scale.Visible then
  1188.             if ScalePosition = spAboveOrLeft then
  1189.                 OrigY := aRect.Bottom - FThumbHeight div 2
  1190.             else if ScalePosition = spBelowOrRight then
  1191.                 OrigY := aRect.Top + FThumbHeight div 2;
  1192.   
  1193.     OrigX := AWidth div 2 + aRect.Left;
  1194.     if Orientation = orVertical then
  1195.         if Scale.Visible then
  1196.             if ScalePosition = spAboveOrLeft then
  1197.                 OrigX := aRect.Right - FThumbWidth div 2
  1198.             else if ScalePosition = spBelowOrRight then
  1199.                 OrigX := aRect.Left + FThumbWidth div 2;
  1201.     if not FPicLeft.Empty then
  1202.         if Orientation = orHorizontal then
  1203.         begin
  1204.           DrawPic(FPicLeft,Bounds(aRect.Left,OrigY-FPicLeft.Height div 2,FPicLeft.Width,FPicLeft.Height));
  1205.           Inc(aRect.Left,FPicLeft.Width);
  1206.         end
  1207.         else
  1208.         begin
  1209.            DrawPic(FPicLeft,Bounds(OrigX-FPicLeft.Width div 2,aRect.Top,FPicLeft.Width,FPicLeft.Height));
  1210.            Inc(aRect.Top,FPicLeft.Height);
  1211.         end;
  1213.     if not FPicRight.Empty then
  1214.         if Orientation = orHorizontal then
  1215.         begin
  1216.            DrawPic(FPicRight,Bounds(aRect.Right-FPicRight.Width,OrigY-FPicRight.Height div 2,
  1217.                    FPicRight.Width,FPicRight.Height));
  1218.            Dec(aRect.Right,FPicRight.Width);
  1219.         end
  1220.         else
  1221.         begin
  1222.            DrawPic(FPicRight,Bounds(OrigX-FPicRight.Width div 2,aRect.Bottom-FPicRight.Height,
  1223.                    FPicRight.Width,FPicRight.Height));
  1224.            Dec(aRect.Bottom,FPicRight.Height);
  1225.         end;
  1227.     Result := aRect;
  1228. end;
  1230. {-- TMMCustomSlider -----------------------------------------------------}
  1231. procedure TMMCustomSlider.SetPicLeft(Value: TBitmap);
  1232. begin
  1233.    FPicLeft.Assign(Value);
  1234. end;
  1236. {-- TMMCustomSlider -----------------------------------------------------}
  1237. procedure TMMCustomSlider.SetPicRight(Value: TBitmap);
  1238. begin
  1239.    FPicRight.Assign(Value);
  1240. end;
  1242. {-- TMMCustomSlider -----------------------------------------------------}
  1243. procedure TMMCustomSlider.Paint;
  1244. var
  1245.    aRect: TRect;
  1247. begin
  1248.    if (FBitmap = nil) then exit;
  1250.    with FBitmap do
  1251.    begin
  1252.       { draw the Bevel and fill the area }
  1253.       aRect := Bevel.PaintBevel(Canvas, ClientRect,True);
  1254.       with FBitmap.Canvas do
  1255.       begin
  1256.          Brush.Color := Color;
  1257.          Brush.Style := bsSolid;
  1258.          FillRect(aRect);
  1260.          aRect := DrawPics(Canvas,aRect);
  1261.          WhereIsThumb(aRect,FThumbRect);
  1262.          DrawTrench(Canvas, aRect);
  1263.          DrawThumb(Canvas, FThumbRect);
  1264.      
  1265.       end;
  1266.    end;
  1267.    Canvas.Draw(0,0,FBitmap); 
  1268. end;
  1270. {-- TMMCustomSlider -----------------------------------------------------}
  1271. function TMMCustomSlider.DrawGroove(Canvas: TCanvas; aRect: TRect): TRect;
  1272. begin
  1273.    if FGrooveStyle = gsOwnerDraw then
  1274.    begin
  1275.       InflateRect(aRect,0,-FGroove.BevelExtend);
  1276.       OwnerDrawGroove(Canvas,aRect);
  1277.       Result := aRect;
  1278.    end
  1279.    else
  1280.       Result := FGroove.PaintBevel(Canvas, aRect, True);
  1281. end;
  1283. {-- TMMCustomSlider -----------------------------------------------------}
  1284. procedure TMMCustomSlider.SetThumbCursor(AtThumb: Boolean);
  1285. begin
  1286.    if AtThumb then
  1287.       if FHandCursor then
  1288.          SetCursor(Screen.Cursors[crsHand5])
  1289.       else
  1290.          SetCursor(Screen.Cursors[ThumbCursor])
  1291.    else
  1292.        SetCursor(Screen.Cursors[Cursor]);
  1293. end;
  1295. {-- TMMCustomSlider -----------------------------------------------------}
  1296. procedure TMMCustomSlider.CMMouseEnter(var msg: TMessage);
  1297. begin
  1298.    if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  1299. end;
  1301. {-- TMMCustomSlider -----------------------------------------------------}
  1302. procedure TMMCustomSlider.CMMouseLeave(var msg: TMessage);
  1303. begin
  1304.    if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  1305. end;
  1307. end.