mmspin.pas

一套及时通讯的原码

         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;