mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 15:39:49 +02:00
LCL: add ItemProps to ValueListEditor
git-svn-id: trunk@39659 -
This commit is contained in:
juha
parent
b9f6d06750
commit
074f42f249
226
lcl/valedit.pas
226
lcl/valedit.pas
@ -5,26 +5,71 @@ unit ValEdit;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Grids, LResources, Dialogs, LazUtf8;
|
||||
Classes, SysUtils, Grids, LResources, Dialogs, LazUtf8, variants;
|
||||
|
||||
type
|
||||
|
||||
{ TValueListStrings }
|
||||
TValueListEditor = class; // Forward declaration
|
||||
|
||||
TValueListEditor = class;
|
||||
TEditStyle = (esSimple, esEllipsis, esPickList);
|
||||
|
||||
{ TItemProp }
|
||||
|
||||
TItemProp = class(TPersistent)
|
||||
private
|
||||
FOwner: TValueListEditor;
|
||||
FEditMask: string;
|
||||
FEditStyle: TEditStyle;
|
||||
FPickList: TStrings;
|
||||
FMaxLength: Integer;
|
||||
FReadOnly: Boolean;
|
||||
FKeyDesc: string;
|
||||
function GetPickList: TStrings;
|
||||
procedure PickListChange(Sender: TObject);
|
||||
procedure SetEditMask(const AValue: string);
|
||||
procedure SetMaxLength(const AValue: Integer);
|
||||
procedure SetReadOnly(const AValue: Boolean);
|
||||
procedure SetEditStyle(const AValue: TEditStyle);
|
||||
procedure SetPickList(const AValue: TStrings);
|
||||
procedure SetKeyDesc(const AValue: string);
|
||||
protected
|
||||
// procedure AssignTo(Dest: TPersistent); override;
|
||||
public
|
||||
constructor Create(AOwner: TValueListEditor);
|
||||
destructor Destroy; override;
|
||||
// function HasPickList: Boolean;
|
||||
published
|
||||
property EditMask: string read FEditMask write SetEditMask;
|
||||
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
|
||||
property KeyDesc: string read FKeyDesc write SetKeyDesc;
|
||||
property PickList: TStrings read GetPickList write SetPickList;
|
||||
property MaxLength: Integer read FMaxLength write SetMaxLength;
|
||||
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
|
||||
end;
|
||||
|
||||
TItemProps = array of TItemProp;
|
||||
|
||||
{ TValueListStrings }
|
||||
|
||||
TValueListStrings = class(TStringList)
|
||||
private
|
||||
FOwner: TValueListEditor;
|
||||
FItemProps: TItemProps;
|
||||
function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
|
||||
protected
|
||||
procedure SetTextStr(const Value: string); override;
|
||||
procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
|
||||
procedure Put(Index: Integer; const S: String); override;
|
||||
public
|
||||
constructor Create(AOwner: TValueListEditor);
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure Clear; override;
|
||||
procedure CustomSort(Compare: TStringListSortCompare); override;
|
||||
procedure Delete(Index: Integer); override;
|
||||
procedure Exchange(Index1, Index2: Integer); override;
|
||||
end;
|
||||
|
||||
{ TValueListEditor }
|
||||
|
||||
TDisplayOption = (doColumnTitles, doAutoColResize, doKeyColFixed);
|
||||
TDisplayOptions = set of TDisplayOption;
|
||||
@ -38,6 +83,8 @@ type
|
||||
TOnValidateEvent = procedure(Sender: TObject; ACol, ARow: Longint;
|
||||
const KeyName, KeyValue: string) of object;
|
||||
|
||||
{ TValueListEditor }
|
||||
|
||||
TValueListEditor = class(TCustomStringGrid)
|
||||
private
|
||||
FTitleCaptions: TStrings;
|
||||
@ -51,7 +98,9 @@ type
|
||||
FOnStringsChanging: TNotifyEvent;
|
||||
FOnValidate: TOnValidateEvent;
|
||||
function GetFixedRows: Integer;
|
||||
function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
|
||||
procedure SetFixedRows(AValue: Integer);
|
||||
procedure SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
|
||||
procedure StringsChange(Sender: TObject);
|
||||
procedure StringsChanging(Sender: TObject);
|
||||
function GetOptions: TGridOptions;
|
||||
@ -88,6 +137,7 @@ type
|
||||
property Modified;
|
||||
property Keys[Index: Integer]: string read GetKey write SetKey;
|
||||
property Values[const Key: string]: string read GetValue write SetValue;
|
||||
property ItemProps[const AKeyOrIndex: Variant]: TItemProp read GetItemProp write SetItemProp;
|
||||
published
|
||||
// Same as in TStringGrid
|
||||
property Align;
|
||||
@ -216,6 +266,87 @@ procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{ TItemProp }
|
||||
|
||||
constructor TItemProp.Create(AOwner: TValueListEditor);
|
||||
begin
|
||||
inherited Create;
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
destructor TItemProp.Destroy;
|
||||
begin
|
||||
FPickList.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TItemProp.GetPickList: TStrings;
|
||||
begin
|
||||
if FPickList = Nil then
|
||||
begin
|
||||
FPickList := TStringList.Create;
|
||||
TStringList(FPickList).OnChange := @PickListChange;
|
||||
end;
|
||||
Result := FPickList;
|
||||
end;
|
||||
|
||||
procedure TItemProp.PickListChange(Sender: TObject);
|
||||
begin
|
||||
if PickList.Count > 0 then begin
|
||||
if EditStyle = esSimple then
|
||||
EditStyle := esPickList;
|
||||
end
|
||||
else begin
|
||||
if EditStyle = esPickList then
|
||||
EditStyle := esSimple;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetEditMask(const AValue: string);
|
||||
begin
|
||||
FEditMask := AValue;
|
||||
with FOwner do
|
||||
if EditorMode and (FStrings.UpdateCount = 0) then
|
||||
InvalidateCell(Col, Row);
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetMaxLength(const AValue: Integer);
|
||||
begin
|
||||
FMaxLength := AValue;
|
||||
with FOwner do
|
||||
if EditorMode and (FStrings.UpdateCount = 0) then
|
||||
InvalidateCell(Col, Row);
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
FReadOnly := AValue;
|
||||
with FOwner do
|
||||
if EditorMode and (FStrings.UpdateCount = 0) then
|
||||
InvalidateCell(Col, Row);
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetEditStyle(const AValue: TEditStyle);
|
||||
begin
|
||||
FEditStyle := AValue;
|
||||
with FOwner do
|
||||
if EditorMode and (FStrings.UpdateCount = 0) then
|
||||
InvalidateCell(Col, Row);
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetPickList(const AValue: TStrings);
|
||||
begin
|
||||
GetPickList.Assign(AValue);
|
||||
with FOwner do
|
||||
if EditorMode and (FStrings.UpdateCount = 0) then
|
||||
InvalidateCell(Col, Row);
|
||||
end;
|
||||
|
||||
procedure TItemProp.SetKeyDesc(const AValue: string);
|
||||
begin
|
||||
FKeyDesc := AValue;
|
||||
end;
|
||||
|
||||
{ TValueListStrings }
|
||||
|
||||
procedure TValueListStrings.SetTextStr(const Value: string);
|
||||
@ -232,6 +363,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.InsertItem(Index: Integer; const S: string; AObject: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// ToDo: Check validity of key
|
||||
Changing;
|
||||
inherited InsertItem(Index, S, AObject);
|
||||
SetLength(FItemProps, Count);
|
||||
for i := Count-2 downto Index do
|
||||
FItemProps[i+1] := FItemProps[i];
|
||||
FItemProps[Index] := nil;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.Put(Index: Integer; const S: String);
|
||||
begin
|
||||
// ToDo: Check validity of key
|
||||
inherited Put(Index, S);
|
||||
end;
|
||||
|
||||
constructor TValueListStrings.Create(AOwner: TValueListEditor);
|
||||
begin
|
||||
inherited Create;
|
||||
@ -251,12 +402,69 @@ begin
|
||||
// Don't show editor while changing values. Edited cell would not be changed.
|
||||
IsShowingEditor := goAlwaysShowEditor in Options;
|
||||
Options := Options - [goAlwaysShowEditor];
|
||||
// ToDo: Assign also ItemProps if Source is TValueListStrings
|
||||
inherited Assign(Source);
|
||||
if IsShowingEditor then
|
||||
Options := Options + [goAlwaysShowEditor];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.Clear;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Clear;
|
||||
for i := 0 to Length(FItemProps)-1 do
|
||||
FItemProps[i].Free;
|
||||
SetLength(FItemProps, 0);
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
|
||||
begin
|
||||
inherited CustomSort(Compare);
|
||||
// ToDo: Sort also ItemProps using a copy of the orignal order
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.Delete(Index: Integer);
|
||||
begin
|
||||
Changing;
|
||||
inherited Delete(Index);
|
||||
// ToDo: Delete also ItemProps
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TValueListStrings.Exchange(Index1, Index2: Integer);
|
||||
begin
|
||||
Changing;
|
||||
inherited Exchange(Index1, Index2);
|
||||
// ToDo: Exchange also ItemProps
|
||||
Changed;
|
||||
end;
|
||||
|
||||
function TValueListStrings.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
|
||||
var
|
||||
i: Integer;
|
||||
s: string;
|
||||
begin
|
||||
Result := Nil;
|
||||
if Count > 0 then
|
||||
begin
|
||||
if VarIsOrdinal(AKeyOrIndex) then
|
||||
i := AKeyOrIndex
|
||||
else begin
|
||||
s := AKeyOrIndex;
|
||||
i := IndexOfName(s);
|
||||
if i = -1 then
|
||||
raise Exception.Create('TValueListStrings.GetItemProp: Key not found: '+s);
|
||||
end;
|
||||
Result := FItemProps[i];
|
||||
if not Assigned(Result) then begin
|
||||
Result := TItemProp.Create(FOwner);
|
||||
FItemProps[i] := Result;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TValueListEditor }
|
||||
|
||||
constructor TValueListEditor.Create(AOwner: TComponent);
|
||||
@ -334,6 +542,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TValueListEditor.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
|
||||
begin
|
||||
Result := FStrings.GetItemProp(AKeyOrIndex);
|
||||
end;
|
||||
|
||||
procedure TValueListEditor.SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
|
||||
begin
|
||||
FStrings.GetItemProp(AKeyOrIndex).Assign(AValue);
|
||||
end;
|
||||
|
||||
function TValueListEditor.GetOptions: TGridOptions;
|
||||
begin
|
||||
Result := inherited Options;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user