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

📄 suiradiogroup.pas

📁 新颖按钮控件
💻 PAS
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIRadioGroup.pas
//  Creator     :   Shen Min
//  Date        :   2002-09-22
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUIRadioGroup;

interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Forms,
     SUIImagePanel, SUIGroupBox, SUIButton, SUIThemes;

type
    TsuiCheckGroup = class(TsuiCustomGroupBox)
    private
        m_Items : TStrings;
        m_Buttons : TList;
        m_Columns : Integer;
        m_UIStyle : TsuiUIStyle;
        m_TopMargin : Integer;

        m_OnClick : TNotifyEvent;

        procedure ItemChanged(Sender : TObject);
        procedure SetItems(const Value: TStrings);

        function UpdateButtons() : Boolean;
        procedure ArrangeButtons();
        procedure SetColumns(const Value: Integer);
        procedure SetTopMargin(const Value: Integer);
        function GetChecked(Index: Integer): Boolean;
        procedure SetChecked(Index: Integer; const Value: Boolean);
        procedure SetUIStyle(const Value: TsuiUIStyle);

        procedure DoClick(Sender : TObject);

    protected
        function CreateAButton() : TsuiCheckBox; virtual;
        procedure ReSize(); override;

        procedure SetTransparent(const Value: Boolean); override;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        procedure UpdateUIStyle(UIStyle : TsuiUIStyle); override;

        property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;

    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property Items : TStrings read m_Items write SetItems;
        property Columns : Integer read m_Columns write SetColumns;
        property TopMargin : Integer read m_TopMargin write SetTopMargin;
        property BorderColor;

        property OnClick : TNotifyEvent read m_OnClick write m_OnClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnStartDock;
        property OnStartDrag;

    end;

    TsuiRadioGroup = class(TsuiCheckGroup)
    private
        procedure SetItemIndex(const Value: Integer);
        function GetItemIndex: Integer;

    protected
        function CreateAButton() : TsuiCheckBox; override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property ItemIndex : Integer read GetItemIndex write SetItemIndex;

    end;


implementation

uses SUIPublic;

{ TsuiCheckGroup }

procedure TsuiCheckGroup.ArrangeButtons;
var
    R : TRect;
    nHeight : Integer;
    i : Integer;
    ButtonsPerCol : Integer;
    ButtonWidth : Integer;
    ButtonHeight : Integer;
    TopMargin : Integer;
begin
    if m_Buttons.Count = 0 then
        Exit;

    R := GetClient();
    R.Top := R.Top + m_TopMargin;

    nHeight := R.Bottom - R.Top;

    ButtonsPerCol := (m_Buttons.Count + m_Columns - 1) div m_Columns;
    ButtonWidth := (Width - 10) div m_Columns;
    ButtonHeight := nHeight div ButtonsPerCol;
    TopMargin := R.Top + (nHeight mod ButtonsPerCol) div 2;

    for i := 0 to m_Buttons.Count - 1 do
    begin
{$WARNINGS OFF}
        TsuiCheckBox(m_Buttons[i]).Left := (i div ButtonsPerCol) * ButtonWidth + 8;
        TsuiCheckBox(m_Buttons[i]).Top := (I mod ButtonsPerCol) * ButtonHeight + TopMargin;
{$WARNINGS ON}
    end;
end;

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

    m_Items := TStringList.Create();
    (m_Items as TStringList).OnChange := ItemChanged;

    m_Buttons := TList.Create();

    m_Columns := 1;
    m_TopMargin := 8;
    Caption := 'suiCheckGroup';
    UIStyle := GetSUIFormStyle(TCustomForm(AOwner));
    Transparent := false;
    ParentColor := true;

    inherited OnClick := DoClick;
end;

function TsuiCheckGroup.CreateAButton: TsuiCheckBox;
begin
    Result := TsuiCheckBox.Create(self);
end;

destructor TsuiCheckGroup.Destroy;
begin
    m_Buttons.Free();
    m_Buttons := nil;

    m_Items.Free();
    m_Items := nil;

    inherited;
end;

procedure TsuiCheckGroup.ItemChanged(Sender: TObject);
var
    bRepaint : Boolean;
begin
    bRepaint := UpdateButtons();
    ArrangeButtons();

    if bRepaint then
    begin
        Transparent := not Transparent;
        Transparent := not Transparent;
    end;
end;

procedure TsuiCheckGroup.SetItems(const Value: TStrings);
begin
    m_Items.Assign(Value);
end;

procedure TsuiCheckGroup.ReSize;
begin
    inherited;

    ArrangeButtons();
end;

function TsuiCheckGroup.UpdateButtons() : Boolean;
var
    i : Integer;
    nItems : Integer;
    AButton : TsuiCheckBox;
begin
    Result := false;
    nItems := m_Items.Count - m_Buttons.Count;
    if nItems > 0 then
    begin
        for i := 1 to nItems do
        begin
            AButton := CreateAButton();
            AButton.Parent := self;
            AButton.AutoSize := true;
            AButton.UIStyle := m_UIStyle;
            AButton.Transparent := Transparent;
            AButton.ParentColor := true;
            AButton.OnClick := DoClick;
            m_Buttons.Add(AButton);
            Result := true;
        end;
    end
    else if nItems < 0 then
    begin
        for i := 1 to Abs(nItems) do
        begin
{$WARNINGS OFF}
            TsuiCheckBox(m_Buttons[m_Buttons.Count - 1]).Free();
{$WARNINGS ON}
            m_Buttons.Delete(m_Buttons.Count - 1);
        end;
    end;

    for i := 0 to m_Buttons.Count - 1 do
{$WARNINGS OFF}
        TsuiCheckBox(m_Buttons[i]).Caption := m_Items[i];
{$WARNINGS ON}
end;

procedure TsuiCheckGroup.SetColumns(const Value: Integer);
begin
    if Value < 0 then
        Exit;
    m_Columns := Value;

    ArrangeButtons();
end;

function TsuiCheckGroup.GetChecked(Index: Integer): Boolean;
begin
    Result := false;
    if (
        (Index > m_Buttons.Count - 1) or
        (Index < 0)
    ) then
        Exit;
{$WARNINGS OFF}
    Result := TsuiCheckBox(m_Buttons[Index]).Checked;
{$WARNINGS ON}
end;

procedure TsuiCheckGroup.SetChecked(Index: Integer; const Value: Boolean);
begin
{$WARNINGS OFF}
    TsuiCheckBox(m_Buttons[Index]).Checked := Value;
{$WARNINGS ON}
end;

procedure TsuiCheckGroup.SetUIStyle(const Value: TsuiUIStyle);
var
    i : Integer;
begin
    m_UIStyle := Value;

    UpdateUIStyle(m_UIStyle);

    for i := 0 to m_Buttons.Count - 1 do
    begin
{$WARNINGS OFF}
        TsuiCheckBox(m_Buttons[i]).UIStyle := m_UIStyle;
        TsuiCheckBox(m_Buttons[i]).Color := Color;
{$WARNINGS ON}
    end;
end;

procedure TsuiCheckGroup.UpdateUIStyle(UIStyle: TsuiUIStyle);
begin
    BorderColor := GetThemeColor(
        UIStyle,
        SUI_CONTROL_BORDER_COLOR
    );
    Font.Color := GetThemeColor(
        UIStyle,
        SUI_CONTROL_FONT_COLOR
    );

    if not ParentColor then
        Color := GetThemeColor(
            UIStyle,
            SUI_CONTROL_BACKGROUND_COLOR
        );
end;

procedure TsuiCheckGroup.SetTransparent(const Value: Boolean);
var
    i : Integer;
begin
    inherited;

    if m_Buttons = nil then
        Exit;

    for i := 0 to m_Buttons.Count - 1 do
{$WARNINGS OFF}
        TsuiCheckBox(m_Buttons[i]).Transparent := Value;
{$WARNINGS ON}
end;

procedure TsuiCheckGroup.DoClick(Sender: TObject);
begin
    if Assigned(m_OnClick) then
        m_OnClick(self);
end;

procedure TsuiCheckGroup.SetTopMargin(const Value: Integer);
begin
    if Value < 0 then
        Exit;
    m_TopMargin := Value;

    ArrangeButtons();
end;

{ TsuiRadioGroup }

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

    Caption := 'suiRadioGroup';
end;

function TsuiRadioGroup.CreateAButton: TsuiCheckBox;
begin
    Result := TsuiRadioButton.Create(self);
end;

function TsuiRadioGroup.GetItemIndex: Integer;
var
    i : Integer;
begin
    Result := -1;

    for i := 0 to m_Buttons.Count - 1 do
    begin
{$WARNINGS OFF}
        if TsuiRadioButton(m_Buttons[i]).Checked then
{$WARNINGS ON}
        begin
            Result := i;
            break;
        end;
    end;
end;

procedure TsuiRadioGroup.SetItemIndex(const Value: Integer);
var
    i : Integer;
begin
    if Value > m_Items.Count - 1 then
        Exit;
    if Value < -1 then
        Exit;

{$WARNINGS OFF}
    if Value >= 0 then
        TsuiRadioButton(m_Buttons[Value]).Checked := true
    else // -1
    begin
        for i := 0 to m_Buttons.Count - 1 do
            TsuiRadioButton(m_Buttons[i]).Checked := false;
    end;
{$WARNINGS ON}
end;

end.

⌨️ 快捷键说明

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