mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 12:18:03 +02:00
TradioGroup and TCheckGroup: fix accessing Items inside Items.BeginUpdate/Items.EndUpdate.
Fixes issue #0024753. git-svn-id: trunk@42772 -
This commit is contained in:
parent
0c111ebf85
commit
471ec807d9
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user