TradioGroup and TCheckGroup: fix accessing Items inside Items.BeginUpdate/Items.EndUpdate.

Fixes issue #0024753.

git-svn-id: trunk@42772 -
This commit is contained in:
bart 2013-09-13 14:47:32 +00:00
parent 0c111ebf85
commit 471ec807d9
3 changed files with 95 additions and 29 deletions

View File

@ -618,7 +618,6 @@ type
procedure ItemKeyPress(Sender: TObject; var Key: Char);
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure ItemResize(Sender: TObject);
procedure ItemsChanged(Sender: TObject);
procedure SetAutoFill(const AValue: Boolean);
procedure SetColumnLayout(const AValue: TColumnLayout);
procedure UpdateControlsPerLine;
@ -626,6 +625,8 @@ type
procedure UpdateTabStops;
protected
class procedure WSRegisterClass; override;
procedure UpdateInternalObjectList;
procedure UpdateAll;
procedure InitializeWnd; override;
procedure UpdateRadioButtonStates; virtual;
procedure ReadState(Reader: TReader); override;
@ -724,7 +725,6 @@ type
function GetCheckEnabled(Index: integer): boolean;
procedure Clicked(Sender: TObject);
procedure DoClick(Index: integer);
procedure ItemsChanged (Sender : TObject);
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyPress(Sender: TObject; var Key: Char);
@ -738,6 +738,8 @@ type
procedure UpdateControlsPerLine;
protected
class procedure WSRegisterClass; override;
procedure UpdateInternalObjectList;
procedure UpdateAll;
procedure SetItems(Value: TStrings);
procedure SetColumns(Value: integer);
procedure DefineProperties(Filer: TFiler); override;

View File

@ -12,6 +12,36 @@
*****************************************************************************
}
type
{ TCheckGroupStringList }
TCheckGroupStringList = class(TStringList)
private
FCheckGroup: TCustomCheckGroup;
protected
procedure Changed; override;
public
constructor Create(TheCheckGroup: TCustomCheckGroup);
end;
{ TCheckGroupStringList }
procedure TCheckGroupStringList.Changed;
begin
inherited Changed;
if (UpdateCount = 0) then
FCheckGroup.UpdateInternalObjectList
else
FCheckGroup.UpdateAll;
end;
constructor TCheckGroupStringList.Create(TheCheckGroup: TCustomCheckGroup);
begin
inherited Create;
FCheckGroup := TheCheckGroup;
end;
{ TCustomCheckGroup }
constructor TCustomCheckGroup.Create(TheOwner: TComponent);
@ -20,9 +50,7 @@ begin
FCreatingWnd := false;
ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csSetCaption,
csDoubleClicks];
FItems := TStringList.Create;
//TStringList(FItems).OnChanging := @ItemsChanged;
TStringList(FItems).OnChange := @ItemsChanged;
FItems := TCheckGroupStringList.Create(Self);
FButtonList := TList.Create;
FColumnLayout := clHorizontalThenVertical;
FColumns := 1;
@ -44,13 +72,6 @@ begin
inherited Destroy;
end;
procedure TCustomCheckGroup.ItemsChanged(Sender: TObject);
begin
UpdateItems;
UpdateControlsPerLine;
OwnerFormDesignerModified(Self);
end;
procedure TCustomCheckGroup.ItemKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
@ -177,6 +198,18 @@ begin
RegisterCustomCheckGroup;
end;
procedure TCustomCheckGroup.UpdateInternalObjectList;
begin
UpdateItems;
end;
procedure TCustomCheckGroup.UpdateAll;
begin
UpdateItems;
UpdateControlsPerLine;
OwnerFormDesignerModified(Self);
end;
function TCustomCheckGroup.GetCheckEnabled(Index: integer): boolean;
begin
if (Index < -1) or (Index >= FItems.Count) then

View File

@ -16,6 +16,40 @@
- FlipChildren procedure is missing
}
type
{ TCheckGroupStringList }
{ TRadioGroupStringList }
TRadioGroupStringList = class(TStringList)
private
FRadioGroup: TCustomRadioGroup;
protected
procedure Changed; override;
public
constructor Create(TheRadioGroup: TCustomRadioGroup);
end;
{ TCheckGroupStringList }
procedure TRadioGroupStringList.Changed;
begin
inherited Changed;
if (UpdateCount = 0) then
FRadioGroup.UpdateInternalObjectList
else
FRadioGroup.UpdateAll;
end;
constructor TRadioGroupStringList.Create(TheRadioGroup: TCustomRadioGroup);
begin
inherited Create;
FRadioGroup := TheRadioGroup;
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.Create
Params: TheOwner: the owner of the class
@ -28,10 +62,8 @@ begin
inherited Create (TheOwner);
ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csSetCaption,
csDoubleClicks];
FItems := TStringList.Create;
FItems := TRadioGroupStringList.Create(Self);
FAutoFill := true;
//TStringList(FItems).OnChanging := @ItemsChanged;
TStringList(FItems).OnChange := @ItemsChanged;
FItemIndex := -1;
FLastClickedItemIndex := -1;
FButtonList := TFPList.Create;
@ -279,19 +311,6 @@ begin
UTF8KeyPress(UTF8Key);
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.ItemsChanged
Params: sender : object calling this proc. (in fact the FItems instance)
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.ItemsChanged (Sender : TObject);
begin
UpdateItems;
UpdateControlsPerLine;
OwnerFormDesignerModified(Self);
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.SetColumns
Params: value - no of columns of the radiogroup
@ -301,7 +320,7 @@ end;
which the radiobuttons should be arranged.
Range: 1 .. ???
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.SetColumns(value : integer);
procedure TCustomRadioGroup.SetColumns(Value: integer);
begin
if Value <> FColumns then begin
if (Value < 1)
@ -492,6 +511,18 @@ begin
RegisterPropertyToSkip(TCustomRadioGroup, 'DoubleBuffered', 'VCL compatibility property', '');
end;
procedure TCustomRadioGroup.UpdateInternalObjectList;
begin
UpdateItems;
end;
procedure TCustomRadioGroup.UpdateAll;
begin
UpdateItems;
UpdateControlsPerLine;
OwnerFormDesignerModified(Self);
end;
procedure TCustomRadioGroup.SetAutoFill(const AValue: Boolean);
begin
if FAutoFill=AValue then exit;