?? rxspin.pas
字號:
end;
{$ENDIF WIN32}
function TRxSpinEdit.GetButtonWidth: Integer;
begin
{$IFDEF WIN32}
if FUpDown <> nil then Result := FUpDown.Width else
{$ENDIF}
if FButton <> nil then Result := FButton.Width
else Result := DefBtnWidth;
end;
procedure TRxSpinEdit.ResizeButton;
{$IFDEF WIN32}
var
R: TRect;
{$ENDIF}
begin
{$IFDEF WIN32}
if FUpDown <> nil then begin
FUpDown.Width := DefBtnWidth;
{$IFDEF RX_D4}
if (BiDiMode = bdRightToLeft) then FUpDown.Align := alLeft else
{$ENDIF}
FUpDown.Align := alRight;
end
else if FButton <> nil then begin { bkDiagonal }
if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then
R := Bounds(Width - Height - 1, -1, Height - 3, Height - 3)
else
R := Bounds(Width - Height, 0, Height, Height);
{$IFDEF RX_D4}
if (BiDiMode = bdRightToLeft) then begin
if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then begin
R.Left := -1;
R.Right := Height - 4;
end
else begin
R.Left := 0;
R.Right := Height;
end;
end;
{$ENDIF}
with R do
FBtnWindow.SetBounds(Left, Top, Right - Left, Bottom - Top);
FButton.SetBounds(0, 0, FBtnWindow.Width, FBtnWindow.Height);
end;
{$ELSE}
if FButton <> nil then begin
FBtnWindow.SetBounds(Width - Height, 0, Height, Height);
FButton.SetBounds(0, 0, FBtnWindow.Width, FBtnWindow.Height);
end;
{$ENDIF}
end;
procedure TRxSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if ArrowKeys and (Key in [VK_UP, VK_DOWN]) then begin
if Key = VK_UP then UpClick(Self)
else if Key = VK_DOWN then DownClick(Self);
Key := 0;
end;
end;
procedure TRxSpinEdit.Change;
begin
if not FChanging then inherited Change;
end;
procedure TRxSpinEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then begin
inherited KeyPress(Key);
if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then begin
{ must catch and remove this, since is actually multi-line }
GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
if Key = Char(VK_RETURN) then Key := #0;
end;
end;
end;
function TRxSpinEdit.IsValidChar(Key: Char): Boolean;
var
ValidChars: set of Char;
begin
ValidChars := ['+', '-', '0'..'9'];
if ValueType = vtFloat then begin
if Pos(DecimalSeparator, Text) = 0 then
ValidChars := ValidChars + [DecimalSeparator];
if Pos('E', AnsiUpperCase(Text)) = 0 then
ValidChars := ValidChars + ['e', 'E'];
end
else if ValueType = vtHex then begin
ValidChars := ValidChars + ['A'..'F', 'a'..'f'];
end;
Result := (Key in ValidChars) or (Key < #32);
if not FEditorEnabled and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;
procedure TRxSpinEdit.CreateParams(var Params: TCreateParams);
const
{$IFDEF RX_D4}
Alignments: array[Boolean, TAlignment] of DWORD =
((ES_LEFT, ES_RIGHT, ES_CENTER), (ES_RIGHT, ES_LEFT, ES_CENTER));
{$ELSE}
Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
{$ENDIF}
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN or
{$IFDEF RX_D4}
Alignments[UseRightToLeftAlignment, FAlignment];
{$ELSE}
Alignments[FAlignment];
{$ENDIF}
end;
procedure TRxSpinEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
procedure TRxSpinEdit.SetEditRect;
var
Loc: TRect;
begin
{$IFDEF RX_D4}
if (BiDiMode = bdRightToLeft) then
SetRect(Loc, GetButtonWidth + 1, 0, ClientWidth - 1,
ClientHeight + 1) else
{$ENDIF RX_D4}
SetRect(Loc, 0, 0, ClientWidth - GetButtonWidth - 2, ClientHeight + 1);
SendMessage(Handle, EM_SETRECTNP, 0, Longint(@Loc));
end;
procedure TRxSpinEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TRxSpinEdit.WMSize(var Message: TWMSize);
var
MinHeight: Integer;
begin
inherited;
MinHeight := GetMinHeight;
{ text edit bug: if size to less than minheight, then edit ctrl does
not display the text }
if Height < MinHeight then
Height := MinHeight
else begin
ResizeButton;
SetEditRect;
end;
end;
procedure TRxSpinEdit.GetTextHeight(var SysHeight, Height: Integer);
var
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
SysHeight := SysMetrics.tmHeight;
Height := Metrics.tmHeight;
end;
function TRxSpinEdit.GetMinHeight: Integer;
var
I, H: Integer;
begin
GetTextHeight(I, H);
if I > H then I := H;
Result := H + {$IFNDEF WIN32} (I div 4) + {$ENDIF}
(GetSystemMetrics(SM_CYBORDER) * 4) + 1;
end;
procedure TRxSpinEdit.UpClick(Sender: TObject);
var
OldText: string;
begin
if ReadOnly then MessageBeep(0)
else begin
FChanging := True;
try
OldText := inherited Text;
Value := Value + FIncrement;
finally
FChanging := False;
end;
if CompareText(inherited Text, OldText) <> 0 then begin
Modified := True;
Change;
end;
if Assigned(FOnTopClick) then FOnTopClick(Self);
end;
end;
procedure TRxSpinEdit.DownClick(Sender: TObject);
var
OldText: string;
begin
if ReadOnly then MessageBeep(0)
else begin
FChanging := True;
try
OldText := inherited Text;
Value := Value - FIncrement;
finally
FChanging := False;
end;
if CompareText(inherited Text, OldText) <> 0 then begin
Modified := True;
Change;
end;
if Assigned(FOnBottomClick) then FOnBottomClick(Self);
end;
end;
{$IFDEF RX_D4}
procedure TRxSpinEdit.CMBiDiModeChanged(var Message: TMessage);
begin
inherited;
ResizeButton;
SetEditRect;
end;
{$ENDIF}
procedure TRxSpinEdit.CMFontChanged(var Message: TMessage);
begin
inherited;
ResizeButton;
SetEditRect;
end;
procedure TRxSpinEdit.CMCtl3DChanged(var Message: TMessage);
begin
inherited;
ResizeButton;
SetEditRect;
end;
procedure TRxSpinEdit.CMEnabledChanged(var Message: TMessage);
begin
inherited;
{$IFDEF WIN32}
if FUpDown <> nil then begin
FUpDown.Enabled := Enabled;
ResizeButton;
end;
{$ENDIF}
if FButton <> nil then FButton.Enabled := Enabled;
end;
procedure TRxSpinEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TRxSpinEdit.WMCut(var Message: TWMCut);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TRxSpinEdit.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue(Value) <> Value then SetValue(Value);
end;
procedure TRxSpinEdit.CMEnter(var Message: TMessage);
begin
if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
inherited;
end;
function TRxSpinEdit.GetValue: Extended;
begin
try
if ValueType = vtFloat then Result := StrToFloat(Text)
else if ValueType = vtHex then Result := StrToInt('$' + Text)
else Result := StrToInt(Text);
except
if ValueType = vtFloat then Result := FMinValue
else Result := Trunc(FMinValue);
end;
end;
procedure TRxSpinEdit.SetValue(NewValue: Extended);
begin
if ValueType = vtFloat then
Text := FloatToStrF(CheckValue(NewValue), ffFixed, 15, FDecimal)
else if ValueType = vtHex then
Text := IntToHex(Round(CheckValue(NewValue)), 1)
else
Text := IntToStr(Round(CheckValue(NewValue)));
end;
function TRxSpinEdit.GetAsInteger: Longint;
begin
Result := Trunc(GetValue);
end;
procedure TRxSpinEdit.SetAsInteger(NewValue: Longint);
begin
SetValue(NewValue);
end;
procedure TRxSpinEdit.SetValueType(NewType: TValueType);
begin
if FValueType <> NewType then begin
FValueType := NewType;
Value := GetValue;
if FValueType in [{$IFDEF CBUILDER} vtInt {$ELSE} vtInteger {$ENDIF}, vtHex] then
begin
FIncrement := Round(FIncrement);
if FIncrement = 0 then FIncrement := 1;
end;
end;
end;
function TRxSpinEdit.IsIncrementStored: Boolean;
begin
Result := FIncrement <> 1.0;
end;
function TRxSpinEdit.IsMaxStored: Boolean;
begin
Result := (MaxValue <> 0.0);
end;
function TRxSpinEdit.IsMinStored: Boolean;
begin
Result := (MinValue <> 0.0);
end;
function TRxSpinEdit.IsValueStored: Boolean;
begin
Result := (GetValue <> 0.0);
end;
procedure TRxSpinEdit.SetDecimal(NewValue: Byte);
begin
if FDecimal <> NewValue then begin
FDecimal := NewValue;
Value := GetValue;
end;
end;
function TRxSpinEdit.CheckValue(NewValue: Extended): Extended;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -