paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 01:19:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: customradiogroup is now streamable

Browse Source 
git-svn-id: trunk@226 -
This commit is contained in:
lazarus 2001-03-15 14:42:20 +00:00
parent 9522dc1fd6
commit d7a5998509
2 changed files with 52 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
lcl/extctrls.pp
View File

@ -271,24 +271,26 @@ type
TCustomRadioGroup = class(TCustomGroupBox)
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
function CanModify : boolean; virtual;
procedure CreateWnd; override;
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
function CanModify : boolean; virtual;
procedure CreateWnd; override;
private
FButtonList : TList;
FItems : TStrings;
FItemIndex : integer;
FColumns : integer;
procedure ItemsChanged (Sender : TObject);
FButtonList : TList;
FItems : TStrings;
FItemIndex : integer;
FColumns : integer;
FReading : boolean;
procedure ItemsChanged (Sender : TObject);
protected
procedure SetItem (value : TStrings);
procedure SetColumns (value : integer);
procedure SetItemIndex (value : integer);
function GetItemIndex : integer;
property ItemIndex : integer read GetItemIndex write SetItemIndex default -1;
property Items : TStrings read FItems write SetItem;
property Columns : integer read FColumns write SetColumns default 1;
procedure ReadState(Reader: TReader); override;
procedure SetItem (value : TStrings);
procedure SetColumns (value : integer);
procedure SetItemIndex (value : integer);
function GetItemIndex : integer;
property ItemIndex : integer read GetItemIndex write SetItemIndex default -1;
property Items : TStrings read FItems write SetItem;
property Columns : integer read FColumns write SetColumns default 1;
end;
TRadioGroup = class(TCustomRadioGroup)
@ -326,6 +328,9 @@ end.
{
$Log$
Revision 1.8 2001/03/15 14:42:20 lazarus
MG: customradiogroup is now streamable
Revision 1.7 2001/01/12 18:27:31 lazarus
Streaming additions by MAttias
Shane

38
lcl/include/customradiogroup.inc
View File

@ -187,20 +187,23 @@ end;
Select one of the radiobuttons
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.SetItemIndex (value : integer);
procedure TCustomRadioGroup.SetItemIndex (Value : integer);
begin
if (Value < -1) or (Value >= FItems.Count)
if FReading then FItemIndex:=Value
else begin
if (Value < -1) or (Value >= FItems.Count)
then raise Exception.Create('TCustomRadioGroup: Out of bounds');
if (HandleAllocated) and (value <> FItemIndex) then
begin
if (HandleAllocated) and (value <> FItemIndex) then
begin
if (FItemIndex <> -1)
then TRadioButton (FButtonList [FItemIndex]).Checked := false;
FItemIndex := value;
if (value <> -1)
then TRadioButton (FButtonList [value]).Checked := true;
end
else FItemIndex := value;
end
else FItemIndex := value;
end;
end;
{------------------------------------------------------------------------------
@ -218,7 +221,8 @@ begin
if (HandleAllocated) then
begin
i := 0;
// This nasty little loop is neccessary because the group is not informed when a button is pressed
// This nasty little loop is neccessary because the group is not informed
// when a button is pressed
while (i < FButtonList.Count) and (result = -1) do
begin // find the actice button
if TRadioButton (FButtonList [i]).Checked
@ -243,8 +247,28 @@ begin
result := true;
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.ReadState
Params: Reader: TReader
executed when component is read from stream
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.ReadState(Reader: TReader);
begin
FReading := True;
inherited ReadState(Reader);
FReading := False;
if HandleAllocated then RecreateWnd;
end;
{
$Log$
Revision 1.5 2001/03/15 14:42:20 lazarus
MG: customradiogroup is now streamable
Revision 1.4 2001/02/06 13:38:58 lazarus
Fixes from Mattias for EditorOPtions
Fixes to COmpiler that should allow people to compile if their path is set up.