Delphi控件源码

开发平台：
Delphi

MMSpin.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
Unit MMSpin;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    ExtCtrls,
    StdCtrls,
    Menus,
    Buttons,
    MMSystem,
    MMObj,
    MMUtils,
    MMString,
    MMButton;
type
  TMMTimeBtnState = set of (tbFocusRect, tbAllowTimer, tbDragging);
  TMMFocusStyle   = (fsNone,fsSolid,fsDot);
  TMMOrientation  = (orVertical,orHorizontal);
  {== TMMTimerSpeedButton ================================================}
  TMMTimerSpeedButton = class(TMMSpeedButton)
  private
    FButtonFace  : Boolean;
    FFocusColor  : TColor;
    FFocusStyle  : TMMFocusStyle;
    FRepeatTimer : TTimer;
    FTimeBtnState: TMMTimeBtnState;
    procedure TimerExpired(Sender: TObject);
    procedure FocusLine(X1,Y1,X2,Y2: integer);
    procedure SetButtonFace(aValue: Boolean);
    procedure SetEnabled(aValue: Boolean);
    function  GetEnabled: Boolean;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                      X, Y: Integer); override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    property TimeBtnState: TMMTimeBtnState read FTimeBtnState write FTimeBtnState;
    property FocusColor: TColor read FFocusColor write FFocusColor;
    property FocusStyle: TMMFocusStyle read FFocusStyle write FFocusStyle default fsSolid;
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    property ButtonFace: Boolean read FButtonFace write SetButtonFace default False;
  end;
  {== TMMCustomSpinButton ===============================================}
  TMMCustomSpinButton = class(TMMCustomControl)
  private
    FUpButton      : TMMTimerSpeedButton;
    FDownButton    : TMMTimerSpeedButton;
    FFastButton    : TMMTimerSpeedButton;
    FFocusedButton : TMMTimerSpeedButton;
    FFocusControl  : TWinControl;
    FFocusColor    : TColor;
    FFocusStyle    : TMMFocusStyle;
    FButtonFace    : Boolean;
    FMiddleButton  : Boolean;
    FOrientation   : TMMOrientation;
    FIncrement     : LongInt;
    FMinValue      : LongInt;
    FMaxValue      : LongInt;
    FValue         : Longint;
    FStartValue    : Longint;
    FOldPos        : integer;
    FOldWndProc     : TFarProc;
    FHookWnd        : HWND;
    FOnUpClick     : TNotifyEvent;
    FOnDownClick   : TNotifyEvent;
    FOnChange      : TNotifyEvent;
    function  CreateButton: TMMTimerSpeedButton;
    function  GetUpGlyph: TBitmap;
    function  GetDownGlyph: TBitmap;
    procedure SetUpGlyph(Value: TBitmap);
    procedure SetUpNumGlyphs(Value: TNumGlyphs);
    function  GetUpNumGlyphs: TNumGlyphs;
    procedure SetDownGlyph(Value: TBitmap);
    procedure SetDownNumGlyphs(Value: TNumGlyphs);
    function  GetDownNumGlyphs: TNumGlyphs;
    procedure SetFocusColor(Value: TColor);
    procedure SetFocusStyle(Value: TMMFocusStyle);
    procedure SetFocusControl(aControl: TWinControl);
    procedure SetEnabled(Value: Boolean);
    function  GetEnabled: Boolean;
    procedure SetButtonFace(Value: Boolean);
    procedure SetMiddleButton(Value: Boolean);
    procedure SetOrientation(aValue: TMMOrientation);
    procedure SetIncrement(aValue: Longint);
    procedure SetMaxValue(aValue: Longint);
    procedure SetMinValue(aValue: Longint);
    procedure SetValue(aValue: Longint);
    procedure BtnClick(Sender: TObject);
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton;
                           Shift: TShiftState; X, Y: Integer);
    procedure BtnMouseMove(Sender: TObject; Shift: TShiftState;
                           X, Y: Integer);
    procedure BtnMouseUp(Sender: TObject; Button: TMouseButton;
                         Shift: TShiftState; X, Y: Integer);
    procedure SetFocusBtn(Btn: TMMTimerSpeedButton);
    procedure UpdateMiddleButton;
    procedure AdjustBounds;
    procedure AdjustSize (var W, H: Integer);
    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure HookWndProc(var Message : TMessage);
    function  ProcessKeys(Wnd: HWND; Msg, Key: Word): Boolean;
    procedure UpdateButtonState;
  protected
    procedure Loaded; override;
    procedure Changed; override;
    procedure Paint; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Notification(aComponent: TComponent; Operation: TOperation); override ;
    procedure UpClicked; dynamic;
    procedure DownClicked; dynamic;
    procedure Change; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property  UpButton: TMMTimerSpeedButton read FUpButton write FUpButton;
    property  DownButton: TMMTimerSpeedButton read FDownButton write FDownButton;
    property  FocusStyle: TMMFocusStyle read FFocusStyle write SetFocusStyle default fsSolid;
  protected
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
    property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
    { Orientation must be the first }
    property Orientation: TMMOrientation read FOrientation write SetOrientation default orVertical;
    property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
    property DownNumGlyphs: TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs;
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    property FocusColor: TColor read FFocusColor write SetFocusColor default clBlack;
    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
    property TabStop default True;
    property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
    property UpNumGlyphs: TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs;
    property Width default 21;
    property Height default 28;
    property ButtonFace: Boolean read FButtonFace write SetButtonFace default False;
    property MiddleButton: Boolean read FMiddleButton write SetMiddleButton default False;
    property Increment: Longint read FIncrement write SetIncrement default 1;
    property MaxValue: LongInt read FMaxValue write SetMaxValue default 100;
    property MinValue: LongInt read FMinValue write SetMinValue default 0;
    property Value: Longint read FValue write SetValue default 0;
  end;
  {== TMMCustomSpinButton ===============================================}
  TMMSpinButton = class(TMMCustomSpinButton)
  published
    property OnChange;
    property OnDownClick;
    property OnUpClick;
    property Bevel;
    property Orientation;
    property DownGlyph;
    property DownNumGlyphs;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FocusColor;
    property FocusControl;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabStop;
    property TabOrder;
    property UpGlyph;
    property UpNumGlyphs;
    property Visible;
    property Width;
    property Height;
    property ButtonFace;
    property MiddleButton;
    property Increment;
    property MaxValue;
    property MinValue;
    property Value;
  end;
implementation
{$IFDEF WIN32}
  {$R MMSPIN.D32}
{$ELSE}
  {$R MMSPIN.D16}
{$ENDIF}
const
     InitialPause = 400;  { time in ms before first repeat occurs }
     RepeatPause  = 50;   { time in ms between subsequent repeats }
     HookList: TList = nil;
{== TMMTimerSpeedButton ==================================================}
constructor TMMTimerSpeedButton.Create(aOwner: TComponent);
begin
     inherited Create(aOwner);
     FFocusColor := clBlack;
     FFocusStyle := fsSolid;
     FRepeatTimer:= Nil;
     FButtonFace := False;
     Enabled := True;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
destructor TMMTimerSpeedButton.Destroy;
begin
     if (FRepeatTimer <> Nil) then
        FRepeatTimer.Free;
     inherited Destroy;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.SetButtonFace(aValue: Boolean);
begin
   if (aValue <> FButtonFace) then
   begin
      FButtonFace := aValue;
      Invalidate;
   end;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.SetEnabled(aValue: Boolean);
begin
     if (aValue <> inherited Enabled) then
     begin
          {$IFNDEF BUILD_ACTIVEX}
          if Not (csDesigning in ComponentState) then
          begin
               { Win31 makes problems without this }
               if (Parent <> Nil) And (FState = bsDown) then
               begin
                    Parent.Enabled := not Parent.Enabled;
                    Parent.Enabled := not Parent.Enabled;
                    Parent.SetFocus;
               end;
          end;
          {$ENDIF}
          inherited Enabled := aValue;
     end;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
function TMMTimerSpeedButton.GetEnabled: Boolean;
begin
     Result := inherited Enabled;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
     inherited MouseDown (Button, Shift, X, Y);
     if tbAllowTimer in FTimeBtnState then
     begin
          if (FRepeatTimer = Nil) then
          begin
             FRepeatTimer := TTimer.Create(Self);
             FRepeatTimer.OnTimer := TimerExpired;
          end;
          FRepeatTimer.Interval := InitialPause;
          FRepeatTimer.Enabled  := True;
     end;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
                                  X, Y: Integer);
begin
     inherited MouseUp (Button, Shift, X, Y);
     FRepeatTimer.Free;
     FRepeatTimer := Nil;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.TimerExpired(Sender: TObject);
begin
     FRepeatTimer.Interval := RepeatPause;
     if (FState = bsDown) And MouseCapture then
     begin
          try
             Click;
          except
             FRepeatTimer.Enabled := False;
             raise;
          end;
     end;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.FocusLine(X1,Y1,X2,Y2: integer);
Var
   i: integer;
begin
   if (FFocusStyle = fsDot) then
   begin
     if (X1 = X2) then
     begin
          i := Y1;
          while i < Y2 do
          begin
               Canvas.Pixels[X1, i] := FFocusColor;
               inc(i,2)
          end;
     end
     else if (Y1 = Y2) then
     begin
          i := X1;
          while i < X2 do
          begin
               Canvas.Pixels[i, Y1] := FFocusColor;
               inc(i,2)
          end;
     end;
   end
   else if (FFocusStyle = fsSolid) then
   begin
        Canvas.MoveTo(X1, Y1);
        Canvas.LineTo(X2, Y2);
   end;
end;
{-- TMMTimerSpeedButton --------------------------------------------------}
procedure TMMTimerSpeedButton.Paint;
Var
   R: TRect;
begin
   if (Not Enabled) And Not(csDesigning in ComponentState) then
   begin
      FState := bsDisabled;
      FDragging := False;
   end
   else if FState = bsDisabled then
   FState := bsUp;
   with Canvas do
   begin
      R := ClientRect;
      Brush.Color := clBtnFace;
      FillRect(R);
      if FButtonFace then
      begin
         if (FState in [bsDown]) or (tbDragging in FTimeBtnState) then
         begin
            OffsetRect(R,1,1);
            DrawGlyph(Canvas, R);
            OffsetRect(R,-1,-1);
            Frame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
            Pixels[R.Left-1,R.Bottom] := clBtnShadow;
            Pixels[R.Right,R.Top-1] := clBtnShadow;
         end
         else
         begin
            Frame3D(Canvas, R, clBtnHighLight,clBtnShadow,1);
            DrawGlyph(Canvas, R);
         end;
      end
      else DrawGlyph(Canvas, R);
      if Parent.Focused and not TMMCustomSpinButton(Parent).FButtonFace then
      begin
         R := Bounds(0, 0, Width-1, Height-1);
         InflateRect(R, -1, -1);
         Pen.Color := FFocusColor;
         if (TMMCustomSpinButton(Parent).Orientation = orVertical) then
         begin
            if (Self = TMMCustomSpinButton(Parent).FUpButton) then
            begin
               FocusLine(R.Left, R.Top, R.Left, R.Bottom+2);
               FocusLine(R.Left+1, R.Top, R.Right, R.Top);
               FocusLine(R.Right, R.Top, R.Right, R.Bottom+2);
            end
            else if (Self = TMMCustomSpinButton(Parent).FDownButton) then
            begin
               FocusLine(R.Left, R.Top-1, R.Left, R.Bottom);
               FocusLine(R.Left, R.Bottom, R.Right+1, R.Bottom);
               FocusLine(R.Right, R.Top-1, R.Right, R.Bottom);
            end
            else
            begin
               R := Bounds(0, 0, Width-1, Height-1);
               FocusLine(R.Left, R.Top, R.Left, R.Bottom+1);
               FocusLine(R.Right, R.Top, R.Right, R.Bottom+1);
            end;
         end
         else
         begin
            if (Self = TMMCustomSpinButton(Parent).FUpButton) then
            begin
               FocusLine(R.Left-1, R.Top, R.Right+1, R.Top);
               FocusLine(R.Right, R.Top, R.Right, R.Bottom);
               FocusLine(R.Left-1, R.Bottom, R.Right+1, R.Bottom);
            end
            else if (Self = TMMCustomSpinButton(Parent).FDownButton) then
            begin
               FocusLine(R.Left, R.Top, R.Right+2, R.Top);
               FocusLine(R.Left, R.Top, R.Left, R.Bottom);
               FocusLine(R.Left, R.Bottom, R.Right+2, R.Bottom);
            end
            else
            begin
               R := Bounds(0, 0, Width-1, Height-1);
               FocusLine(R.Left, R.Top, R.Right+1, R.Top);
               FocusLine(R.Left, R.Bottom, R.Right+1, R.Bottom);
            end;
         end;
      end;
   end;
end;
{== TMMCustomSpinButton =================================================}
constructor TMMCustomSpinButton.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption,csDoubleClicks];
     FValue := 0;
     FMinValue := 0;
     FMaxValue := 100;
     FIncrement := 1;
     FFocusColor := clBlack;
     FFocusStyle := fsSolid;
     FButtonFace := False;
     FMiddleButton := False;
     FUpButton := CreateButton;
     FDownButton := CreateButton;
     FDownButton.Enabled := False;
     FFastButton := nil;
     FOrientation := orVertical;
     UpGlyph := nil;
     DownGlyph := nil;
     FOldWndProc := nil;
     FHookWnd    := 0;
     Enabled := True;
     Width := 21;
     Height := 28;
     FFocusedButton := FUpButton;
     TabStop := True;
     ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
     if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
destructor TMMCustomSpinButton.Destroy;
begin
   FocusControl := nil;
   inherited Destroy;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.Notification(aComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(aComponent,Operation);
   if (Operation = opRemove) then
   begin
      if FocusControl = aComponent then FocusControl := nil;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.HookWndProc(var Message: TMessage);
   procedure Default;
   begin
      with Message do
      Result := CallWindowProc(FOldWndProc,FHookWnd,Msg,wParam,lParam);
   end;
begin
   with Message do
   begin
      if (csLButtonDown in FUpButton.ControlState) or
         (csLButtonDown in FDownButton.ControlState) or
         not ProcessKeys(FHookWnd,Msg, wParam) then default;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.ProcessKeys(Wnd: HWND; Msg, Key: Word): Boolean;
begin
    Result := True;
    begin
       case Msg of
        WM_KEYDOWN:
             if ((Key = VK_UP) and (FOrientation = orVertical)) or
                ((Key = VK_RIGHT) and (FOrientation = orHorizontal)) then
             begin
                SetFocusBtn(FUpButton);
                if (bsDown <> FUpButton.FState) and FUpButton.Enabled then
                begin
                   FUpButton.FState := bsDown;
                   FUpButton.Refresh;
                end;
                FUpButton.Click;
                exit;
             end
             else if ((Key = VK_DOWN) and (FOrientation = orVertical)) or
                     ((Key = VK_LEFT) and (FOrientation = orHorizontal)) then
             begin
                SetFocusBtn(FDownButton);
                if (bsDown <> FDownButton.FState)  and FDownButton.Enabled then
                begin
                   FDownButton.FState := bsDown;
                   FDownButton.Refresh;
                end;
                FDownButton.Click;
                exit;
             end;
          WM_KEYUP:
             case Key of
                 VK_UP,
                 VK_DOWN,
                 VK_LEFT,
                 VK_RIGHT:
                 if (FFocusedButton <> nil) then
                 begin
                    FFocusedButton.FState := bsUp;
                    FFocusedButton.Refresh;
                    exit;
                 end;
             end;
          VK_SPACE: if (Wnd = Handle) then FFocusedButton.Click;
       end;
    end;
    Result := False;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.CreateButton: TMMTimerSpeedButton;
begin
     Result := TMMTimerSpeedButton.Create(Self);
     Result.Parent        := Self;
     Result.OnClick       := BtnClick;
     Result.OnMouseDown   := BtnMouseDown;
     Result.OnMouseUp     := BtnMouseUp;
     Result.OnMouseMove   := BtnMouseMove;
     Result.Visible       := True;
     Result.ParentShowHint:= False;
     Result.TimeBtnState  := [tbAllowTimer];
     Result.NumGlyphs     := 1;
     Result.Enabled       := True;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.UpdateMiddleButton;
begin
   if FMiddleButton and (FFastButton <> nil) then
   begin
      FFastButton.Enabled     := Enabled;
      FFastButton.ButtonFace  := True;
      FFastButton.FocusColor  := FFocusColor;
      FFastButton.FocusStyle  := FFocusStyle;
      FFastButton.TimeBtnState:= [];
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetMiddleButton(Value: Boolean);
begin
   if (Value <> FMiddleButton) then
   begin
      if (FFastButton <> nil) then
      begin
         FFastButton.Free;
         FFastButton := nil;
      end;
      FMiddleButton := Value;
      if FMiddleButton then
      begin
         FFastButton := CreateButton;
         FFastButton.GroupIndex := 0;
         FFastButton.Glyph := nil;
         UpdateMiddleButton;
      end;
      AdjustBounds;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetFocusControl(aControl: TWinControl);
begin
   if (aControl <> FFocusControl) then
   begin
      { unhook the controls WndProc }
      if FHookWnd <> 0 then
      begin
         FreeObjectInstance(TFarProc(SetWindowLong(FHookWnd,GWL_WNDPROC,LongInt(FOldWndProc))));
         FHookWnd := 0;
         if (FFocusControl <> nil) and (HookList <> nil) then
         begin
            HookList.Remove(FFocusControl);
            HookList.Pack;
            if (HookList.Count = 0) then
            begin
               HookList.Free;
               HookList := nil;
            end;
         end;
      end;
      FFocusControl := aControl;
      if (FFocusControl <> nil) and (FFocusControl is TCustomEdit) then
      begin
         { is Control already Hooked ? }
         if (HookList <> nil) and (HookList.IndexOf(FFocusControl) >= 0) then
         begin
            FFocusControl := nil;
            MessageDlg('Control is already Hooked', mtError, [mbOK],0);
            exit;
         end;
         if (HookList = nil) then HookList := TList.Create;
         { Add the control to the Hook list }
         HookList.Add(FFocusControl);
         { hook the controls WndProc }
         FHookWnd    := FFocusControl.Handle;
         FOldWndProc := TFarProc(SetWindowLong(FHookWnd,GWL_WNDPROC,
                        LongInt(MakeObjectInstance(HookWndProc))));
      end;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetOrientation(aValue: TMMOrientation);
begin
   if (aValue <> FOrientation) then
   begin
      FOrientation := aValue;
      if (csDesigning in ComponentState) then
      begin
         UpGlyph      := nil;
         DownGlyph    := nil;
      end;
      AdjustBounds;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.AdjustSize (var W, H: Integer);
var
   Bev,Size: integer;
begin
     if (FUpButton = nil) or
        (csLoading in ComponentState) or
        (csReading in ComponentState) then Exit;
     Bev := BevelExtend;
     if (FOrientation = orVertical) then
     begin
        if FButtonFace then
        begin
           if FMiddleButton then
           begin
              Size := 5;
              W := Max(W,2*Bev+2+UpGlyph.Width div UpNumGlyphs);
              H := Max(H,2*Bev+4+UpGlyph.Height+DownGlyph.Height+1+Size);
              FUpButton.SetBounds(Bev, Bev, W-2*Bev, (H-2*Bev-Size) div 2);
              FDownButton.SetBounds(Bev, FUpButton.Height+Bev+1+Size, W-2*Bev, (H-2*Bev-Size) - FUpButton.Height-1);
              FFastButton.SetBounds(Bev, FUpButton.Height+Bev+1, W-2*Bev, Size-1);
           end
           else
           begin
              W := Max(W,2*Bev+2+UpGlyph.Width div UpNumGlyphs);
              H := Max(H,2*Bev+4+UpGlyph.Height+DownGlyph.Height+1);
              FUpButton.SetBounds(Bev, Bev, W-2*Bev, (H-2*Bev) div 2);
              FDownButton.SetBounds(Bev, FUpButton.Height+Bev+1, W-2*Bev, (H-2*Bev) - FUpButton.Height-1);
           end;
        end
        else
        begin
           if FMiddleButton then
           begin
              Size := 6;
              W := Max(W,2*Bev+UpGlyph.Width div UpNumGlyphs);
              H := Max(H,2*Bev+UpGlyph.Height+DownGlyph.Height+Size);
              FUpButton.SetBounds (Bev, Bev, W-2*Bev, (H-2*Bev-Size) div 2);
              FDownButton.SetBounds (Bev, FUpButton.Height+Bev+Size, W-2*Bev, (H-2*Bev-Size) - FUpButton.Height);
              FFastButton.SetBounds(Bev+1, FUpButton.Height+Bev+1, W-2*Bev-2, Size-2);
           end
           else
           begin
              W := Max(W,2*Bev+UpGlyph.Width div UpNumGlyphs);
              H := Max(H,2*Bev+UpGlyph.Height+DownGlyph.Height);
              FUpButton.SetBounds (Bev, Bev, W-2*Bev, (H-2*Bev) div 2);
              FDownButton.SetBounds (Bev, FUpButton.Height+Bev, W-2*Bev, (H-2*Bev) - FUpButton.Height);
           end;
        end;
     end
     else
     begin
        if FButtonFace then
        begin
           if FMiddleButton then
           begin
              Size := 5;
              W := Max(W,2*Bev+4+DownGlyph.Width div DownNumGlyphs+UpGlyph.Width div UpNumGlyphs+1+Size);
              H := Max(H,2*Bev+2+DownGlyph.Height);
              FDownButton.SetBounds(Bev, Bev, (W-2*Bev-Size) div 2, H-2*Bev);
              FUpButton.SetBounds(Bev+FDownButton.Width+1+Size, Bev, (W-2*Bev-Size)-FDownButton.Width-1, H-2*Bev);
              FFastButton.SetBounds(Bev+FDownButton.Width+1, Bev, Size-1, H-2*Bev);
           end
           else
           begin
              W := Max(W,2*Bev+4+DownGlyph.Width div DownNumGlyphs+UpGlyph.Width div UpNumGlyphs+1);
              H := Max(H,2*Bev+2+DownGlyph.Height);
              FDownButton.SetBounds(Bev, Bev, (W-2*Bev) div 2, H-2*Bev);
              FUpButton.SetBounds(Bev+FDownButton.Width+1, Bev, (W-2*Bev)-FDownButton.Width-1, H-2*Bev);
           end;
        end
        else
        begin
           if FMiddleButton then
           begin
              Size := 6;
              W := Max(W,2*Bev+DownGlyph.Width div DownNumGlyphs+UpGlyph.Width div UpNumGlyphs+Size);
              H := Max(H,2*Bev+DownGlyph.Height);
              FDownButton.SetBounds(Bev, Bev, (W-2*Bev-Size) div 2, H-2*Bev);
              FUpButton.SetBounds(Bev+FDownButton.Width+Size, Bev, (W-2*Bev-Size)-FDownButton.Width, H-2*Bev);
              FFastButton.SetBounds(Bev+FDownButton.Width+1, Bev+1, Size-2, H-2*Bev-2);
           end
           else
           begin
              W := Max(W,2*Bev+DownGlyph.Width div DownNumGlyphs+UpGlyph.Width div UpNumGlyphs);
              H := Max(H,2*Bev+DownGlyph.Height);
              FDownButton.SetBounds(Bev, Bev, (W-2*Bev) div 2, H-2*Bev);
              FUpButton.SetBounds(Bev+FDownButton.Width, Bev, (W-2*Bev)-FDownButton.Width, H-2*Bev);
           end;
        end;
     end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  W, H: Integer;
begin
     W := AWidth;
     H := AHeight;
     AdjustSize (W, H);
     inherited SetBounds (ALeft, ATop, W, H);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.AdjustBounds;
var
  W, H: Integer;
begin
     W := Width;
     H := Height;
     AdjustSize (W, H);
     if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H)
     else Invalidate;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.Changed;
begin
     AdjustBounds;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.WMSize(var Message: TWMSize);
begin
     inherited;
     AdjustBounds;
     Message.Result := 0;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.WMSetFocus(var Message: TWMSetFocus);
begin
     FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
     Invalidate;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.WMKillFocus(var Message: TWMKillFocus);
begin
     FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
     Invalidate;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
   ProcessKeys(Handle,WM_KEYDOWN,Key);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
   ProcessKeys(Handle,WM_KEYUP,Key);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.BtnMouseDown(Sender: TObject; Button: TMouseButton;
                                     Shift: TShiftState; X, Y: Integer);
begin
   if (Button = mbLeft) then
   begin
      if (Sender = FFastButton) then
      with FFastButton do
      begin
         FTimeBtnState := FTimeBtnState + [tbDragging];
         FStartValue := Value;
         if (FOrientation = orVertical) then
         begin
            SetCursor(Screen.Cursors[crVSplit]);
            FOldPos := Y;
         end
         else
         begin
            SetCursor(Screen.Cursors[crHSplit]);
            FOldPos := X;
         end;
      end
      else
      begin
         SetFocusBtn(TMMTimerSpeedButton(Sender));
      end;
      if (FFocusControl <> nil) AND FFocusControl.TabStop AND
          FFocusControl.CanFocus then
      begin
         if (GetFocus <> FFocusControl.Handle) then
             FFocusControl.SetFocus
      end
      else if TabStop AND (GetFocus <> Handle) AND CanFocus then SetFocus;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.BtnMouseMove(Sender: TObject; Shift: TShiftState;
                                           X, Y: Integer);
begin
   if (Sender = FFastButton) then
   begin
      if (FOrientation = orVertical) then
      begin
         if (tbDragging in FFastButton.FTimeBtnState) then
         begin
            Value := FStartValue + Trunc((FOldPos - Y) * (MaxValue-MinValue)/100) ;
         end
         else SetCursor(Screen.Cursors[crVSplit])
      end
      else
      begin
         if (tbDragging in FFastButton.FTimeBtnState) then
         begin
            Value := FStartValue + Trunc((FOldPos - X) * (MaxValue-MinValue)/100) ;
         end
         else SetCursor(Screen.Cursors[crHSplit])
      end;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.BtnMouseUp(Sender: TObject; Button: TMouseButton;
                                   Shift: TShiftState; X, Y: Integer);
begin
   if (Button = mbLeft) and (Sender = FFastButton) then
   with FFastButton do
   begin
      FTimeBtnState := FTimeBtnState - [tbDragging];
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.BtnClick(Sender: TObject);
begin
   if (Sender = FUpButton) then
      UpClicked
   else if (Sender = FDownButton) then
      DownClicked;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.UpClicked;
begin
   Value := Value + FIncrement;
   if Assigned(FOnUpClick) then FOnUpClick(Self);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.DownClicked;
begin
   Value := Value - FIncrement;
   if Assigned(FOnDownClick) then FOnDownClick(Self);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.Change;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) then exit;
   if Assigned(FOnChange) then FOnChange(Self);
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetFocusBtn (Btn: TMMTimerSpeedButton);
begin
   if TabStop AND CanFocus AND (Btn <> FFocusedButton) AND (Btn <> FFastButton) then
   begin
      if (FFocusedButton <> nil) then
      begin
         FFocusedButton.FState := bsUp;
         FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
         FFocusedButton.Refresh;
      end;
      FFocusedButton := Btn;
      if (GetFocus = Handle) then
      begin
         FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
         Invalidate;
      end;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
   Message.Result := DLGC_WANTARROWS;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.Loaded;
begin
  inherited Loaded;
  UpdateButtonState;
  AdjustBounds;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.GetUpGlyph: TBitmap;
begin
  Result := FUpButton.Glyph;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetUpGlyph(Value: TBitmap);
begin
   if (Value <> nil) then FUpButton.Glyph := Value
   else
   begin
      if (FOrientation = orVertical) then
          FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'MMSPINUPV')
      else
          FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'MMSPINUPH');
      FUpButton.NumGlyphs := 3;
      FUpButton.Invalidate;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.GetDownGlyph: TBitmap;
begin
   Result := FDownButton.Glyph;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetDownGlyph(Value: TBitmap);
begin
   if Value <> nil then FDownButton.Glyph := Value
   else
   begin
      if (FOrientation = orVertical) then
          FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'MMSPINDOWNV')
      else
          FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'MMSPINDOWNH');
      FDownButton.NumGlyphs := 3;
      FDownButton.Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetDownNumGlyphs(Value: TNumGlyphs);
begin
   FDownButton.NumGlyphs := Value;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.GetDownNumGlyphs: TNumGlyphs;
begin
   Result := FDownButton.NumGlyphs;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetUpNumGlyphs(Value: TNumGlyphs);
begin
   FUpButton.NumGlyphs := Value;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.GetUpNumGlyphs: TNumGlyphs;
begin
   Result := FUpButton.NumGlyphs;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetButtonFace(Value: Boolean);
begin
   if (Value <> FButtonFace) then
   begin
      FButtonFace := Value;
      FUpButton.ButtonFace := Value;
      FDownButton.ButtonFace := Value;
      UpdateMiddleButton;
      AdjustBounds;
      Invalidate;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetFocusColor(Value: TColor);
begin
   if (Value <> FFocusColor) then
   begin
      FFocusColor := Value;
      FUpButton.FocusColor := Value;
      FDownButton.FocusColor := Value;
      UpdateMiddleButton;
      Invalidate;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetFocusStyle(Value: TMMFocusStyle);
begin
   if (Value <> FFocusStyle) then
   begin
      FFocusStyle := Value;
      FUpButton.FocusStyle := Value;
      FDownButton.FocusStyle := Value;
      UpdateMiddleButton;
      Invalidate;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.UpdateButtonState;
begin
   if (FValue = FMinValue) then FDownButton.Enabled := False
   else if Enabled then FDownButton.Enabled := True;
   if (FValue = FMaxValue) then FUpButton.Enabled := False
   else if Enabled then FUpButton.Enabled := True;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetEnabled(Value: Boolean);
begin
   if (Value <> inherited Enabled) then
   begin
      inherited Enabled := Value;
      UpdateMiddleButton;
      if Enabled then UpdateButtonState
      else
      begin
         FUpButton.Enabled := Enabled;
         FDownButton.Enabled := Enabled;
      end;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
{-- TMMCustomSpinButton -------------------------------------------------}
function TMMCustomSpinButton.GetEnabled: Boolean;
begin
     Result := inherited Enabled;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetIncrement(aValue: Longint);
begin
   if (aValue <> FIncrement) then
   begin
      FIncrement := aValue;
   end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetMinValue(aValue: Longint);
begin
     if (aValue <> FMinValue) then
     begin
          FMinValue := aValue;
          if (FValue < FMinValue) then Value := FMinValue;
          UpdateButtonState;
     end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetMaxValue(aValue: Longint);
begin
     if (aValue <> FMaxValue) then
     begin
          FMaxValue := aValue;
          if (FValue > FMaxValue) then Value := FMaxValue;
          UpdateButtonState;
     end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.SetValue(aValue: Longint);
begin
     aValue := MinMax(aValue, FMinValue, FMaxValue);
     if (aValue <> FValue) then
     begin
        FValue := aValue;
        UpdateButtonState;
        Change;
     end;
end;
{-- TMMCustomSpinButton -------------------------------------------------}
procedure TMMCustomSpinButton.Paint;
var
   Bev: integer;
begin
   { paint the Bevel }
   inherited Paint;
   with Canvas do
   begin
      Pen.Color := clBlack;
      Bev := BevelExtend;
      if (FOrientation = orVertical) then
      begin
         if FButtonFace then
         begin
            MoveTo(Bev,Bev+FUpButton.Height);
            LineTo(Width-Bev,Bev+FUpButton.Height);
            if FMiddleButton then
            begin
               MoveTo(Bev,Bev+FUpButton.Height+FFastButton.Height+1);
               LineTo(Width-Bev,Bev+FUpButton.Height+FFastButton.Height+1);
            end;
         end
         else if FMiddleButton then
         begin
            MoveTo(Bev,Bev+FUpButton.Height);
            LineTo(Width-Bev,Bev+FUpButton.Height);
            MoveTo(Bev,Bev+FUpButton.Height);
            LineTo(Bev,Bev+FUpButton.Height+FFastButton.Height+1);
            MoveTo(Width-Bev-1,Bev+FUpButton.Height);
            LineTo(Width-Bev-1,Bev+FUpButton.Height+FFastButton.Height+1);
            MoveTo(Bev,Bev+FUpButton.Height+FFastButton.Height+1);
            LineTo(Width-Bev,Bev+FUpButton.Height+FFastButton.Height+1);
         end;
      end
      else
      begin
         if FButtonFace then
         begin
            MoveTo(Bev+FDownButton.Width,Bev);
            LineTo(Bev+FDownButton.Width,Height-Bev);
            if FMiddleButton then
            begin
               MoveTo(Bev+FDownButton.Width+FFastButton.Width+1,Bev);
               LineTo(Bev+FDownButton.Width+FFastButton.Width+1,Height-Bev);
            end;
         end
         else if FMiddleButton then
         begin
            MoveTo(Bev+FDownButton.Width,Bev);
            LineTo(Bev+FDownButton.Width,Height-Bev);
            MoveTo(Bev+FDownButton.Width+FFastButton.Width+1,Bev);
            LineTo(Bev+FDownButton.Width+FFastButton.Width+1,Height-Bev);
            MoveTo(Bev+FDownButton.Width+1,Bev);
            LineTo(Bev+FDownButton.Width+FFastButton.Width+1,Bev);
            MoveTo(Bev+FDownButton.Width+1,Height-Bev-1);
            LineTo(Bev+FDownButton.Width+FFastButton.Width+1,Height-Bev-1);
         end
      end;
   end;
end;
end.

						