📄 suiradiogroup.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 + -