⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 suiedit.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);          
    end;
end;

procedure TsuiMaskEdit.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;
    Repaint();
end;

procedure TsuiMaskEdit.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiMaskEdit.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
begin
    m_UIStyle := Value;
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_BorderColor := m_FileTheme.GetColor(SKIN2_CONTROLBORDERCOLOR)
    else
        m_BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
    Repaint();
end;

procedure TsuiMaskEdit.WMEARSEBKGND(var Msg: TMessage);
begin
    inherited;

    DrawControlBorder(self, m_BorderColor, Color);
end;

procedure TsuiMaskEdit.WMPAINT(var Msg: TMessage);
begin
    inherited;
    DrawControlBorder(self, m_BorderColor, Color);
end;

{ TsuiNumberEdit }

procedure TsuiNumberEdit.Change;
var
    S : String;
begin
    if (Text <> '') and (Text <> '-') then
    begin
        try
            S := StringReplace(Text, ThousandSeparator, '', [rfReplaceAll]); 
            m_Value := StrToFloat(S);
        except
        on E: EConvertError do
        begin
            SetValue(Value);
            raise;
        end;
        end;
    end;
    inherited;
end;

procedure TsuiNumberEdit.Click;
begin
    inherited;
    DoEnter;
end;

procedure TsuiNumberEdit.CMTextChanged(var Message: TMessage);
begin
    inherited;
    Change();
end;

constructor TsuiNumberEdit.Create(AOwner: TComponent);
begin
    inherited;
    Mask := '0.00';
    Value := 0;
    AutoSelectSigns := 2;
end;

procedure TsuiNumberEdit.CreateParams(var Params: TCreateParams);
begin
    inherited;
    Params.Style := Params.Style + ES_RIGHT;
end;

procedure TsuiNumberEdit.DoEnter;
begin
    inherited;
    if (AutoSelectSigns > 0) and AutoSelect then
    begin
        SelStart := Length(Text) - AutoSelectSigns;
        SelLength := AutoSelectSigns;
    end;
end;

procedure TsuiNumberEdit.DoExit;
var
    S : String;
begin
    inherited;
    if (Text = '') or (Text = '-') then
        Text := '0';
    S := StringReplace(Text, ThousandSeparator, '', [rfReplaceAll]);
    SetValue(StrToFloat(S));
end;

procedure TsuiNumberEdit.KeyPress(var Key: Char);
    function AnsiContainsText(const AText, ASubText: string): Boolean;
    begin
        Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0;
    end;
var
    IsValidKey: Boolean;
begin
    inherited;
    IsValidKey := (Key in ['0'..'9'])
        or ((AnsiContainsText(Mask, '.')
        and ((Key = DecimalSeparator)
        and not (AnsiContainsText(Text, DecimalSeparator)))))
        or (Ord(Key) = VK_BACK)
        or (AnsiContainsText(Mask, '-')
        and ((GetSelStart = 0)
        and (Key = '-'))
        and not (AnsiContainsText(Text, '-')));
    if not IsValidKey then
    begin
        Beep();
        Abort();
    end;
end;

procedure TsuiNumberEdit.SetValue(Value: Real);
begin
    m_Value := Value;
    Text := FormatFloat(m_Mask, Value);
end;

{ TsuiSpinButtons }

procedure TsuiSpinButtons.AdjustSize(var W, H: Integer);
begin
    if (m_UpButton = nil) or (csLoading in ComponentState) then
        Exit;
    if W < 15 then
        W := 15;
    m_UpButton.SetBounds(0, 0, W, H div 2 + 1);
    m_DownButton.SetBounds(0, m_UpButton.Height - 1, W, H - m_UpButton.Height + 1);
end;

procedure TsuiSpinButtons.BtnClick(Sender: TObject);
begin
    if Sender = m_UpButton then
    begin
        if Assigned(m_OnUpClick) then m_OnUpClick(Self);
    end
    else
    begin
        if Assigned(m_OnDownClick) then m_OnDownClick(Self);
    end;
end;

constructor TsuiSpinButtons.Create(AOwner: TComponent);
begin
    inherited;
    ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
        [csFramed, csOpaque];
    m_UpButton := CreateButton;
    m_UpButton.Arrow := suiUp;
    m_DownButton := CreateButton;
    m_DownButton.Arrow := suiDown;
    Width := 20;
    Height := 25;
end;

function TsuiSpinButtons.CreateButton: TsuiArrowButton;
begin
    Result := TsuiArrowButton.Create(Self);
    Result.TabStop := False;
    Result.OnClick := BtnClick;
    Result.OnMouseContinuouslyDown := BtnClick;
    Result.MouseContinuouslyDownInterval := 400;
    Result.Visible := True;
    Result.Enabled := True;
    Result.Parent := Self;
end;

function TsuiSpinButtons.GetFileTheme: TsuiFileTheme;
begin
    Result := nil;
    if m_UpButton <> nil then
        Result := m_UpButton.FileTheme;
end;

function TsuiSpinButtons.GetUIStyle: TsuiUIStyle;
begin
    Result := SUI_THEME_DEFAULT;
    if m_UpButton <> nil then
        Result := m_UpButton.UIStyle;
end;

procedure TsuiSpinButtons.KeyDown(var Key: Word; Shift: TShiftState);
begin
    case Key of

    VK_UP: m_UpButton.Click;
    VK_DOWN: m_DownButton.Click;

    end;
end;

procedure TsuiSpinButtons.Loaded;
var
    W, H: Integer;
begin
    inherited;
    W := Width;
    H := Height;
    AdjustSize(W, H);
    if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H);
end;

procedure TsuiSpinButtons.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
    W, H: Integer;
begin
    W := AWidth;
    H := AHeight;
    AdjustSize(W, H);
    inherited;
end;

procedure TsuiSpinButtons.SetFileTheme(const Value: TsuiFileTheme);
begin
    if m_UpButton <> nil then
        m_UpButton.FileTheme := Value;
    if m_DownButton <> nil then
        m_DownButton.FileTheme := Value;
    SetUIStyle(UIStyle);
end;

procedure TsuiSpinButtons.SetUIStyle(const Value: TsuiUIStyle);
begin
    if m_UpButton <> nil then
        m_UpButton.UIStyle := Value;
    if m_DownButton <> nil then
        m_DownButton.UIStyle := Value;
end;

procedure TsuiSpinButtons.WMSize(var Message: TWMSize);
var
    W, H: Integer;
begin
    inherited;
    { check for minimum size }
    W := Width;
    H := Height;
    AdjustSize(W, H);
    if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H);
    Message.Result := 0;
end;

{ TsuiSpinEdit }

function TsuiSpinEdit.CheckValue(NewValue: Integer): Integer;
begin
    Result := NewValue;
    if (m_MaxValue <> m_MinValue) then
    begin
        if NewValue < m_MinValue then
            Result := m_MinValue
        else if NewValue > m_MaxValue then
            Result := m_MaxValue;
    end;
end;

procedure TsuiSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
    if AutoSelect and not (csLButtonDown in ControlState) then
        SelectAll();
    inherited;
end;

procedure TsuiSpinEdit.CMExit(var Message: TCMExit);
begin
    inherited;
    if CheckValue(Value) <> Value then
        SetValue(Value);
end;

constructor TsuiSpinEdit.Create(AOwner: TComponent);
begin
    inherited;

    m_Button := TsuiSpinButtons.Create(Self);
    m_Button.Width := 15;
    m_Button.Height := 20;
    m_Button.Visible := True;
    m_Button.Parent := Self;
    m_Button.OnUpClick := UpClick;
    m_Button.OnDownClick := DownClick;
    Text := '0';
    m_Increment := 1;
    m_EditorEnabled := True;
end;

procedure TsuiSpinEdit.CreateParams(var Params: TCreateParams);
begin
    inherited;
    Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TsuiSpinEdit.CreateWnd;
begin
    inherited;
    SetEditRect();
end;

destructor TsuiSpinEdit.Destroy;
begin
    m_Button.Free();
    m_Button := nil;
    inherited;
end;

procedure TsuiSpinEdit.DownClick(Sender: TObject);
begin
    if ReadOnly then
        MessageBeep(0)
    else
        Value := Value - m_Increment;
end;

procedure TsuiSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
    // do nothing
end;

function TsuiSpinEdit.GetValue: Integer;
begin
    try
        Result := StrToInt(Text);
    except
        Result := m_MinValue;
    end;
end;

function TsuiSpinEdit.IsValidChar(Key: Char): Boolean;
begin
    Result :=
        (Key in ['-', '0'..'9']) or
        ((Key < #32) and (Key <> Chr(VK_RETURN)));

    if not m_EditorEnabled and Result and ((Key >= #32) or
        (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
            Result := False;
end;

procedure TsuiSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
    if Key = VK_UP then
        UpClick(Self)
    else if Key = VK_DOWN then
        DownClick(Self);
    inherited;
end;

procedure TsuiSpinEdit.KeyPress(var Key: Char);
begin
    if not IsValidChar(Key) then
    begin
        Key := #0;
        MessageBeep(0)
    end;
    if Key <> #0 then
        inherited;
end;

procedure TsuiSpinEdit.SetEditRect;
var
    Loc: TRect;
begin
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
    Loc.Bottom := ClientHeight + 1;
    Loc.Right := ClientWidth - m_Button.Width - 2;
    Loc.Top := 0;
    Loc.Left := 0;
    SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
end;

procedure TsuiSpinEdit.SetValue(NewValue: Integer);
begin
    Text := CurrToStr(CheckValue(NewValue));
end;

procedure TsuiSpinEdit.UIStyleChanged;
begin
    if m_Button <> nil then
    begin
        m_Button.UIStyle := UIStyle;
        m_Button.FileTheme := FileTheme;
    end;
end;

procedure TsuiSpinEdit.UpClick(Sender: TObject);
begin
    if ReadOnly then
        MessageBeep(0)
    else
        Value := Value + m_Increment;
end;

procedure TsuiSpinEdit.WMCut(var Message: TWMCut);
begin
    if not m_EditorEnabled or ReadOnly then
        Exit;
    inherited;
end;

procedure TsuiSpinEdit.WMPaste(var Message: TWMPaste);
begin
    if not m_EditorEnabled or ReadOnly then
        Exit;
    inherited;
end;

procedure TsuiSpinEdit.WMSize(var Message: TWMSize);
var
    MinHeight: Integer;
begin
    inherited;
    MinHeight := 0;
    if Height < MinHeight then
        Height := MinHeight
    else if m_Button <> nil then
    begin
        m_Button.SetBounds(Width - m_Button.Width - 4, 0, m_Button.Width, Height - 4);
        SetEditRect();
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -