?? rxspin.pas
字號:
dRect: Integer;
{Temp: TBitmap;}
begin
ABitmap.Height := Height;
ABitmap.Width := Width;
with ABitmap.Canvas do begin
R := Bounds(0, 0, Width, Height);
Pen.Width := 1;
Brush.Color := clBtnFace;
Brush.Style := bsSolid;
FillRect(R);
{ buttons frame }
Pen.Color := clWindowFrame;
Rectangle(0, 0, Width, Height);
MoveTo(-1, Height);
LineTo(Width, -1);
{ top button }
if ADownState = sbTopDown then Pen.Color := clBtnShadow
else Pen.Color := clBtnHighlight;
MoveTo(1, Height - 4);
LineTo(1, 1);
LineTo(Width - 3, 1);
if ADownState = sbTopDown then Pen.Color := clBtnHighlight
else Pen.Color := clBtnShadow;
if ADownState <> sbTopDown then begin
MoveTo(1, Height - 3);
LineTo(Width - 2, 0);
end;
{ bottom button }
if ADownState = sbBottomDown then Pen.Color := clBtnHighlight
else Pen.Color := clBtnShadow;
MoveTo(2, Height - 2);
LineTo(Width - 2, Height - 2);
LineTo(Width - 2, 1);
if ADownState = sbBottomDown then Pen.Color := clBtnShadow
else Pen.Color := clBtnHighlight;
MoveTo(2, Height - 2);
LineTo(Width - 1, 1);
{ top glyph }
dRect := 1;
if ADownState = sbTopDown then Inc(dRect);
R := Bounds(Round((Width / 4) - (FUpBitmap.Width / 2)) + dRect,
Round((Height / 4) - (FUpBitmap.Height / 2)) + dRect, FUpBitmap.Width,
FUpBitmap.Height);
RSrc := Bounds(0, 0, FUpBitmap.Width, FUpBitmap.Height);
{
if Self.Enabled or (csDesigning in ComponentState) then
BrushCopy(R, FUpBitmap, RSrc, FUpBitmap.TransparentColor)
else begin
Temp := CreateDisabledBitmap(FUpBitmap, clBlack);
try
BrushCopy(R, Temp, RSrc, Temp.TransparentColor);
finally
Temp.Free;
end;
end;
}
BrushCopy(R, FUpBitmap, RSrc, FUpBitmap.TransparentColor);
{ bottom glyph }
R := Bounds(Round((3 * Width / 4) - (FDownBitmap.Width / 2)) - 1,
Round((3 * Height / 4) - (FDownBitmap.Height / 2)) - 1,
FDownBitmap.Width, FDownBitmap.Height);
RSrc := Bounds(0, 0, FDownBitmap.Width, FDownBitmap.Height);
{
if Self.Enabled or (csDesigning in ComponentState) then
BrushCopy(R, FDownBitmap, RSrc, FDownBitmap.TransparentColor)
else begin
Temp := CreateDisabledBitmap(FDownBitmap, clBlack);
try
BrushCopy(R, Temp, RSrc, Temp.TransparentColor);
finally
Temp.Free;
end;
end;
}
BrushCopy(R, FDownBitmap, RSrc, FDownBitmap.TransparentColor);
if ADownState = sbBottomDown then begin
Pen.Color := clBtnShadow;
MoveTo(3, Height - 2);
LineTo(Width - 1, 2);
end;
end;
end;
procedure TRxSpinButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
FInvalidate := True;
Invalidate;
end;
procedure TRxSpinButton.TopClick;
begin
if Assigned(FOnTopClick) then begin
FOnTopClick(Self);
if not (csLButtonDown in ControlState) then FDown := sbNotDown;
end;
end;
procedure TRxSpinButton.BottomClick;
begin
if Assigned(FOnBottomClick) then begin
FOnBottomClick(Self);
if not (csLButtonDown in ControlState) then FDown := sbNotDown;
end;
end;
procedure TRxSpinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then begin
if (FFocusControl <> nil) and FFocusControl.TabStop and
FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
FFocusControl.SetFocus;
if FDown = sbNotDown then begin
FLastDown := FDown;
if Y > (-(Height/Width) * X + Height) then begin
FDown := sbBottomDown;
BottomClick;
end
else begin
FDown := sbTopDown;
TopClick;
end;
if FLastDown <> FDown then begin
FLastDown := FDown;
Repaint;
end;
if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self);
FRepeatTimer.OnTimer := TimerExpired;
FRepeatTimer.Interval := InitRepeatPause;
FRepeatTimer.Enabled := True;
end;
FDragging := True;
end;
end;
procedure TRxSpinButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
NewState: TSpinButtonState;
begin
inherited MouseMove(Shift, X, Y);
if FDragging then begin
if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then begin
NewState := FDown;
if Y > (-(Width / Height) * X + Height) then begin
if (FDown <> sbBottomDown) then begin
if FLastDown = sbBottomDown then FDown := sbBottomDown
else FDown := sbNotDown;
if NewState <> FDown then Repaint;
end;
end
else begin
if (FDown <> sbTopDown) then begin
if (FLastDown = sbTopDown) then FDown := sbTopDown
else FDown := sbNotDown;
if NewState <> FDown then Repaint;
end;
end;
end else
if FDown <> sbNotDown then begin
FDown := sbNotDown;
Repaint;
end;
end;
end;
procedure TRxSpinButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if FDragging then begin
FDragging := False;
if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then begin
FDown := sbNotDown;
FLastDown := sbNotDown;
Repaint;
end;
end;
end;
procedure TRxSpinButton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := RepeatPause;
if (FDown <> sbNotDown) and MouseCapture then begin
try
if FDown = sbBottomDown then BottomClick else TopClick;
except
FRepeatTimer.Enabled := False;
raise;
end;
end;
end;
function DefBtnWidth: Integer;
begin
Result := GetSystemMetrics(SM_CXVSCROLL);
if Result > 15 then Result := 15;
end;
{$IFDEF WIN32}
type
TRxUpDown = class(TCustomUpDown)
private
FChanging: Boolean;
procedure ScrollMessage(var Message: TWMVScroll);
procedure WMHScroll(var Message: TWMHScroll); message CN_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message CN_VSCROLL;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnClick;
end;
constructor TRxUpDown.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Orientation := udVertical;
Min := -1;
Max := 1;
Position := 0;
end;
destructor TRxUpDown.Destroy;
begin
OnClick := nil;
inherited Destroy;
end;
procedure TRxUpDown.ScrollMessage(var Message: TWMVScroll);
begin
if Message.ScrollCode = SB_THUMBPOSITION then begin
if not FChanging then begin
FChanging := True;
try
if Message.Pos > 0 then Click(btNext)
else if Message.Pos < 0 then Click(btPrev);
if HandleAllocated then
SendMessage(Handle, UDM_SETPOS, 0, 0);
finally
FChanging := False;
end;
end;
end;
end;
procedure TRxUpDown.WMHScroll(var Message: TWMHScroll);
begin
ScrollMessage(TWMVScroll(Message));
end;
procedure TRxUpDown.WMVScroll(var Message: TWMVScroll);
begin
ScrollMessage(Message);
end;
procedure TRxUpDown.WMSize(var Message: TWMSize);
begin
inherited;
if Width <> DefBtnWidth then Width := DefBtnWidth;
end;
{$ENDIF WIN32}
{ TRxSpinEdit }
constructor TRxSpinEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Text := '0';
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 1.0;
FDecimal := 2;
FEditorEnabled := True;
{$IFDEF WIN32}
FButtonKind := bkDiagonal;
{$ENDIF}
FArrowKeys := True;
RecreateButton;
end;
destructor TRxSpinEdit.Destroy;
begin
Destroying;
FChanging := True;
if FButton <> nil then begin
FButton.Free;
FButton := nil;
FBtnWindow.Free;
FBtnWindow := nil;
end;
{$IFDEF WIN32}
if FUpDown <> nil then begin
FUpDown.Free;
FUpDown := nil;
end;
{$ENDIF}
inherited Destroy;
end;
procedure TRxSpinEdit.RecreateButton;
begin
if (csDestroying in ComponentState) then Exit;
FButton.Free;
FButton := nil;
FBtnWindow.Free;
FBtnWindow := nil;
{$IFDEF WIN32}
FUpDown.Free;
FUpDown := nil;
if GetButtonKind = bkStandard then begin
FUpDown := TRxUpDown.Create(Self);
with TRxUpDown(FUpDown) do begin
Visible := True;
SetBounds(0, 0, DefBtnWidth, Self.Height);
{$IFDEF RX_D4}
if (BiDiMode = bdRightToLeft) then Align := alLeft else
{$ENDIF}
Align := alRight;
Parent := Self;
OnClick := UpDownClick;
end;
end
else begin
{$ENDIF}
FBtnWindow := TWinControl.Create(Self);
FBtnWindow.Visible := True;
FBtnWindow.Parent := Self;
FBtnWindow.SetBounds(0, 0, Height, Height);
FButton := TRxSpinButton.Create(Self);
FButton.Visible := True;
FButton.Parent := FBtnWindow;
FButton.FocusControl := Self;
FButton.OnTopClick := UpClick;
FButton.OnBottomClick := DownClick;
FButton.SetBounds(0, 0, FBtnWindow.Width, FBtnWindow.Height);
{$IFDEF WIN32}
end;
{$ENDIF}
end;
procedure TRxSpinEdit.SetArrowKeys(Value: Boolean);
begin
FArrowKeys := Value;
{$IFDEF WIN32}
ResizeButton;
{$ENDIF}
end;
{$IFDEF WIN32}
function TRxSpinEdit.GetButtonKind: TSpinButtonKind;
begin
if NewStyleControls then Result := FButtonKind
else Result := bkDiagonal;
end;
procedure TRxSpinEdit.SetButtonKind(Value: TSpinButtonKind);
var
OldKind: TSpinButtonKind;
begin
OldKind := FButtonKind;
FButtonKind := Value;
if OldKind <> GetButtonKind then begin
RecreateButton;
ResizeButton;
SetEditRect;
end;
end;
procedure TRxSpinEdit.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
if TabStop and CanFocus then SetFocus;
case Button of
btNext: UpClick(Sender);
btPrev: DownClick(Sender);
end;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -