mmspin.pas

一套及时通讯的原码

{-- 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.