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

📄 suibutton.pas

📁 新颖按钮控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:

    m_PicNormal := GetThemeString(UIStyle, SUI_BUTTON_NORMAL_IMAGE);
    m_PicMouseOn := GetThemeString(UIStyle, SUI_BUTTON_MOUSEON_IMAGE);
    m_PicMouseDown := GetThemeString(UIStyle, SUI_BUTTON_MOUSEDOWN_IMAGE);
end;

procedure TsuiButton.SetGlyph(const Value: TBitmap);
begin
    m_Glyph.Assign(Value);
    Repaint();
end;

procedure TsuiButton.SetLayout(const Value: TButtonLayout);
begin
    m_Layout := Value;
    Repaint();
end;

procedure TsuiButton.SetPicMouseDown(const Value: string);
begin
    UIStyle := Custom;
    inherited
end;

procedure TsuiButton.SetPicMouseOn(const Value: string);
begin
    UIStyle := Custom;
    inherited;
end;

procedure TsuiButton.SetPicNormal(const Value: string);
begin
    UIStyle := Custom;
    inherited;
end;

procedure TsuiButton.SetSpacing(const Value: Integer);
begin
    m_Spacing := Value;
    Repaint();
end;

procedure TsuiButton.UIStyleChanged;
begin
    if m_UIStyle = MacOS then
        Height := 23;

    if m_UIStyle = BlueGlass then
        Transparent := true
    else
        Transparent := false;
end;

{ TsuiCustomButtonEx }

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

    ParentColor := true;
    Checked := false;
    TabStop := true;
    if AOwner <> nil then
        UIStyle := GetSUIFormStyle(TCustomForm(AOwner))
    else
        UIStyle := SUI_THEME_DEFAULT;
    Width := 93;
end;

procedure TsuiCustomButtonEx.Resize;
begin
    inherited;

    if AutoSize then
        ReplaceControl();

    Repaint();
end;

procedure TsuiCustomButtonEx.SetChecked(const Value: Boolean);
begin
    if m_Checked = Value then
        Exit;
    m_Checked := Value;

    CheckStateChanged();
    Repaint();
end;

procedure TsuiCustomButtonEx.ReplaceControl;
begin
    ClientHeight := Max((Abs(Font.Height) + 2), GetPicHeight()) + 4;
    ClientWidth := GetPicWidth() + 8 + Canvas.TextWidth(Caption);
end;

procedure TsuiCustomButtonEx.AutoSizeChanged;
begin
    if AutoSize then
        ReplaceControl();
end;

procedure TsuiCustomButtonEx.PaintText(ACanvas: TCanvas; Text: String);
var
    PicWidth : Integer;
    Y : Integer;
begin
    PicWidth := GetPicWidth();
    Y := (ClientHeight - (Abs(Font.Height) + 2)) div 2;

    if not Enabled then
        ACanvas.Font.Color := clGray;
    ACanvas.Brush.Style := bsClear;
    m_TextRect := Rect(PicWidth + 4, Y, Width, Height);
    DrawText(ACanvas.Handle, PChar(Text), -1, m_TextRect, DT_LEFT or DT_TOP or DT_SINGLELINE);
end;

procedure TsuiCustomButtonEx.CheckStateChanged;
begin
    // do nothing
end;

procedure TsuiCustomButtonEx.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
var
    Y : Integer;
    ImageList : TImageList;
    TransColor : TColor;
begin
    Y := (ClientHeight - GetPicHeight()) div 2;

    TransColor := Bitmap.Canvas.Pixels[0, 0];

    ImageList := TImageList.CreateSize(Bitmap.Width, Bitmap.Height);
    try
        if PicTransparent then
            ImageList.AddMasked(Bitmap, TransColor)
        else
            ImageList.Add(Bitmap, nil);
        ImageList.Draw(ACanvas, 1, Y, 0);
    finally
        ImageList.Free();
    end;
end;

procedure TsuiCustomButtonEx.UIStyleChanged;
begin
    SetButtonPic(m_UIStyle);
end;

procedure TsuiCustomButtonEx.CaptionChanged;
begin
    if AutoSize then
        ReplaceControl();
    Repaint();
end;

procedure TsuiCustomButtonEx.FontChanged;
begin
    inherited;

    if AutoSize then
        ReplaceControl();
    Repaint();
end;

procedure TsuiCustomButtonEx.DoClick;
begin
    // Do nothing
end;

procedure TsuiCustomButtonEx.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if CanFocus then
        SetFocus();

    DoClick();

    inherited;
end;

procedure TsuiCustomButtonEx.CMDialogChar(var Msg: TCMDialogChar);
begin
    inherited;

    if IsAccel(Msg.CharCode, m_Caption) and Enabled then
    begin
        DoClick();
        Msg.Result := 1;
    end
    else
        Msg.Result := 0;
end;

procedure TsuiCustomButtonEx.WMKeyUp(var Msg: TWMKeyUp);
begin
    if (
        ((Msg.CharCode = VK_SPACE) or (Msg.CharCode = VK_RETURN)) and
        Focused and
        Enabled
    ) then
        DoClick();

    inherited;
end;

procedure TsuiCustomButtonEx.PaintFocus(ACanvas: TCanvas);
begin
    ACanvas.Brush.Style := bsSolid;
    Dec(m_TextRect.Left);
    ACanvas.DrawFocusRect(m_TextRect);
end;

{ TsuiCheckBox }

procedure TsuiCheckBox.CheckStateChanged;
begin
    UpdateCheckState();
end;

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

    PicTransparent := false;
    Caption := 'suiCheckBox';
    Height := 17;
end;

procedure TsuiCheckBox.DoClick;
begin
    Checked := not Checked;
end;

procedure TsuiCheckBox.EnableChanged;
begin
    UpdateCheckState();
end;

function TsuiCheckBox.GetPicHeight: Integer;
var
    Bitmap : TBitmap;
    ResName : String;
begin
    Result := 0;
    ResName := GetThemeString(UIStyle, SUI_CHECKBOX_NORMAL_UNCHECK_IMAGE);
    if ResName = '' then
        Exit;
    Bitmap := TBitmap.Create();
    try
        Bitmap.LoadFromResourceName(hInstance, ResName);
        Result := Bitmap.Height;
    finally
        Bitmap.Free();
    end;
end;

function TsuiCheckBox.GetPicWidth: Integer;
var
    Bitmap : TBitmap;
    ResName : String;
begin
    Result := 0;
    ResName := GetThemeString(UIStyle, SUI_CHECKBOX_NORMAL_UNCHECK_IMAGE);
    if ResName = '' then
        Exit;
    Bitmap := TBitmap.Create();
    try
        Bitmap.LoadFromResourceName(hInstance, ResName);
        Result := Bitmap.Width;
    finally
        Bitmap.Free();
    end;
end;

function TsuiCheckBox.GetState: TCheckBoxState;
begin
    if Checked then
        Result := cbChecked
    else
        Result := cbUnchecked
end;

procedure TsuiCheckBox.SetButtonPic(var UIStyle: TsuiUIStyle);
begin
    m_hDLL := hInstance;

    if not m_Checked then
    begin
        if Enabled then
            PicNormalResName := GetThemeString(UIStyle, SUI_CHECKBOX_NORMAL_UNCHECK_IMAGE)
        else
            PicNormalResName := GetThemeString(UIStyle, SUI_CHECKBOX_DISABLE_UNCHECK_IMAGE);
        PicMouseOnResName := GetThemeString(UIStyle, SUI_CHECKBOX_MOUSEON_UNCHECK_IMAGE);
        PicMouseDownResName := GetThemeString(UIStyle, SUI_CHECKBOX_MOUSEDOWN_UNCHECK_IMAGE);
    end
    else
    begin
        if Enabled then
            PicNormalResName := GetThemeString(UIStyle, SUI_CHECKBOX_NORMAL_CHECKED_IMAGE)
        else
            PicNormalResName := GetThemeString(UIStyle, SUI_CHECKBOX_DISABLE_CHECKED_IMAGE);
        PicMouseOnResName := GetThemeString(UIStyle, SUI_CHECKBOX_MOUSEON_CHECKED_IMAGE);
        PicMouseDownResName := GetThemeString(UIStyle, SUI_CHECKBOX_MOUSEDOWN_CHECKED_IMAGE);
    end;
end;

procedure TsuiCheckBox.SetState(const Value: TCheckBoxState);
begin
    if Value = cbChecked then
        Checked := true
    else
        Checked := false;
end;

procedure TsuiCheckBox.Toggle;
begin
    Checked := not Checked;
end;

procedure TsuiCheckBox.TransparentChanged;
begin
    PicTransparent := false;
end;

procedure TsuiCheckBox.UIStyleChanged;
begin
    inherited;

    if (m_UIStyle = MacOS) or (m_UIStyle = Protein) then
        Transparent := true
    else if m_UIStyle <> Custom then
        Transparent := false;
end;

procedure TsuiCheckBox.UpdateCheckState;
begin
    SetButtonPic(m_UIStyle);
end;

{ TsuiRadioButton }

procedure TsuiRadioButton.CheckStateChanged;
begin
    if Checked then
        UnCheckGroup();

    inherited;
end;

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

    PicTransparent := true;
    Caption := 'suiRadioButton';
    Height := 17;
end;

procedure TsuiRadioButton.DoClick;
begin
    if not Checked then
        Checked := true;
end;

procedure TsuiRadioButton.SetButtonPic(var UIStyle: TsuiUIStyle);
begin
    m_hDLL := hInstance;

    if not m_Checked then
    begin
        if Enabled then
            PicNormalResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_NORMAL_UNCHECK_IMAGE)
        else
            PicNormalResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_DISABLE_UNCHECK_IMAGE);
        PicMouseOnResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_MOUSEON_UNCHECK_IMAGE);
        PicMouseDownResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_MOUSEDOWN_UNCHECK_IMAGE);
    end
    else
    begin
        if Enabled then
            PicNormalResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_NORMAL_CHECKED_IMAGE)
        else
            PicNormalResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_DISABLE_CHECKED_IMAGE);
        PicMouseOnResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_MOUSEON_CHECKED_IMAGE);
        PicMouseDownResName := GetThemeString(UIStyle, SUI_RADIOBUTTON_MOUSEDOWN_CHECKED_IMAGE);
    end;

    Repaint();
end;

procedure TsuiRadioButton.TransparentChanged;
begin
    PicTransparent := true;
end;

procedure TsuiRadioButton.UnCheckGroup;
var
    i : Integer;
begin
    if Parent = nil then
        Exit;

    for i := 0 to Parent.ControlCount - 1 do
    begin
        if not (Parent.Controls[i] is TsuiRadioButton) then
            continue;
        if (Parent.Controls[i] as TsuiRadioButton).GroupIndex <> GroupIndex then
            continue;
        if (Parent.Controls[i] = self) then
            continue;
        (Parent.Controls[i] as TsuiRadioButton).Checked := false;
    end;
end;

{ TsuiImageButton }

procedure TsuiImageButton.AutoSizeChanged;
begin
    if Parent = nil then
        Exit;

    m_AutoSize := true;

    if (m_PicNormal.Graphic <> nil) then
    begin
        Height := m_PicNormal.Height;
        Width := m_PicNormal.Width;
    end;
end;

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

    m_PicDisabled := TPicture.Create();
    m_PicNormal := TPicture.Create();
    m_PicMouseDown := TPicture.Create();
    m_PicMouseOn := TPicture.Create();
end;

destructor TsuiImageButton.Destroy;
begin
    m_PicMouseOn.Free();
    m_PicMOuseOn := nil;

    m_PicMouseDown.Free();
    m_PicMouseDown := nil;

    m_PicNormal.Free();
    m_PicMouseDown := nil;

    m_PicDisabled.Free();
    m_PicDisabled := nil;

    inherited;
end;

procedure TsuiImageButton.PaintButtonDisabled(Buf: TBitmap);
begin
    if m_PicDisabled.Graphic <> nil then
        Buf.Assign(m_PicDisabled)
    else if m_PicNormal.Graphic <> nil then
        Buf.Assign(m_PicNormal);
end;

procedure TsuiImageButton.PaintButtonMouseDown(Buf: TBitmap);
begin
    if m_PicMouseDown.Graphic <> nil then
        Buf.Assign(m_PicMouseDown)
    else if m_PicNormal.Graphic <> nil then
        Buf.Assign(m_PicNormal);
end;

procedure TsuiImageButton.PaintButtonMouseOn(Buf: TBitmap);
begin
    if m_PicMouseOn.Graphic <> nil then
        Buf.Assign(m_PicMouseOn)
    else if m_PicNormal.Graphic <> nil then
        Buf.Assign(m_PicNormal);
end;

procedure TsuiImageButton.PaintButtonNormal(Buf: TBitmap);
begin
    if m_PicNormal.Graphic <> nil then
        Buf.Assign(m_PicNormal);
end;

procedure TsuiImageButton.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
begin
    ACanvas.Draw(0, 0, Bitmap);
end;

procedure TsuiImageButton.SetButtonPic(var UIStyle: TsuiUIStyle);
begin
    // do nothing
end;

procedure TsuiImageButton.SetPicDisabledF(const Value: TPicture);
begin
    m_PicDisabled.Assign(Value);
    AutoSizeChanged();
    Repaint();
end;

procedure TsuiImageButton.SetPicMouseDownF(const Value: TPicture);
begin
    m_PicMouseDown.Assign(Value);
    AutoSizeChanged();
    Repaint();
end;

procedure TsuiImageButton.SetPicMouseOnF(const Value: TPicture);
begin
    m_PicMouseOn.Assign(Value);
    AutoSizeChanged();
    Repaint();
end;

procedure TsuiImageButton.SetPicNormalF(const Value: TPicture);
begin
    m_PicNormal.Assign(Value);
    AutoSizeChanged();
    Repaint();
end;

end.

⌨️ 快捷键说明

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